home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 172bbas.zip / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1989-07-30  |  131KB  |  3,806 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 07-30-89
  8. '  Copyright ..........: 1986 - 1989
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  11. '     require error trapping are incorporated within RBBSSUB 2-5 as
  12. '     separately callable subroutines in order to free up as much
  13. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  ACHKMAC     1320   Check/execute macro
  19. '  ANSWERIT     200   Answer the telephone when it rings
  20. '  ASCCODES     129   Allow a CONFIG string to have any ASCII value
  21. '  BADCHAR      455   Check user name for invalid characters
  22. '  BADNAME    20235   Check for system crash attempt with bad file name
  23. '  BAUD450     5507   Allow 300 baud callers to bump up to 450 baud
  24. '  CHECKRATIO 20096   Test upload/download ratio
  25. '  CHKMACRO    1242   Checks for macro and processes
  26. '  COPYWRIT      97   Display RBBS-PC's copyright notice
  27. '  DEFALTU     9600   Write out the user's defaults
  28. '  DENYACCESS  1386   Downgrade security so access denied
  29. '  DOOREXIT   10983   Set up a .BAT file to exit RBBS-PC to a "door"
  30. '  DOSEXIT    10934   Set up a .BAT file to exit to DOS (second level)
  31. '  EDITALINE   2618   Edits a single line
  32. '  EDITDEF            Edit configuration parameters
  33. '  FSECCHK    20240   Matches file name to a prefix & extension
  34. '  GETARC     20140   Handle request for verbose listing
  35. '  GETCOMND     101   Get RBBS-PC's node id from command line
  36. '  GETIME      9140   Calculates callers elapsed time (hours, minutes, seconds)
  37. '  GOIDLE        90   Release resources when waiting for keyboard input
  38. '  KILLMSG     3952   Delete old or unnecessary messages
  39. '  LINE25       945   Build and/or update line 25 of RBBS-PC's local screen
  40. '  LINEEDIT    3700   Edit a line while minimizing string space consumption
  41. '  LOGERROR   13660   Log error message to CALLERS file
  42. '  LPRNT       1480   Subroutine to write to local display
  43. '  MLINIT         8   Handle MultiLink initialization/de-initialization
  44. '  MSGPROT     2055   Sets protection for a message
  45. '  MSGTO       2018   Sets who a message is to
  46. '  PAGLEN      5200   Change page length
  47. '  PARSEIT     1637   Parses a string
  48. '  PASSWRD      660   Verify user & message passwords
  49. '  PSCRN       1483   Print to display
  50. '  QLPRNT      1482   Quickly writes count of blocks on file transfer
  51. '  QTPUT       1478   Fast, but limited, "TPUT" equivalent
  52. '  RBBSEXIT   10992   Common RBBS-PC exit to transfer control to other programs
  53. '  RECOVMSG   10410   Recover a deleted message
  54. '  REMNONALF   5100   Removes non-alpha characters from a string
  55. '  RINGCALLER  1636   Ring caller's bell and put message in emphasis
  56. '  SETBAUD     1654   Set baud rate in the 8250 chip of the RS232 interface
  57. '  SETCRLF     1496   Set up the necessary carriage return/line feed string
  58. '  SETSECT    12000   Set the proper section prompts (main, file, util, libr)
  59. '  SETTHREAD   4554   Set up request for threading thru messages
  60. '  SKIPLINE    1485   Write a # of blank lines to the communications port
  61. '  SRCHCMND    1238   Searches list of commands in RBBS for a request
  62. '  SVIOLATION  1380   Process a security violation
  63. '  SYSMENU      112   Displays sysop menu/status
  64. '  SYSOPCHAT   4773   Sysop and caller chat
  65. '  TESTREL      336   Tests for Reliable connect
  66. '  TGET        1498   Read a line from the communications port
  67. '  TPUT        1396   Write a line to the communications port
  68. '  TRIM         105   Strip leading and trailing blanks from a string
  69. '  TRIMTRAIL    107   Strip off specified string off end of another string
  70. '  UNTILRIGHT 12878   Ask a question until user says answer is right
  71. '  UPDATEU    10600   Updates the user record on loging off/exiting RBBS-PC
  72. '  VARINIT      109   Initialize system variables
  73. '  VIEWHELP    1330   Processes help command
  74. '  WHOCHECK    2250   Checks whether a user exists in user file
  75. '  WHOSON      9801   Report status of each node - who's on
  76. '  WORDINFILE 10976   Find a whole word within a file/menu
  77. '
  78. '  $INCLUDE: 'RBBS-VAR.BAS'
  79. '
  80. 8 '  $SUBTITLE: 'MLINIT - MultiLink initialization/deinitialization'
  81. '  $PAGE
  82. '
  83. '  NAME    -- MLINIT
  84. '
  85. '  INPUTS  --  MLPARM = 1             INITIALIZE AT STARTUP OR RE-
  86. '                                     CYLCE TIME
  87. '              MLPARM = 2             DE-INITIALIZE ON EXITING TO
  88. '                                     A DOOR OR DOS REMOTELY
  89. '              MLPARM = 3             DE-QUEUE COMMUNICATIONS PORTS
  90. '              MLPARM = 4             CHECK FOR MULTILINK PRESENT
  91. '              DOORS.TERMINAL.TYPE
  92. '              BAUD.TEST
  93. '              COM.PORT$
  94. '              COMPUTER.TYPE
  95. '
  96. '  OUTPUTS --  NONE
  97. '
  98. '  PURPOSE --  To test for the presence of multi-link and set
  99. '              multi link options to be compatible with RBBS-PC
  100. '
  101.       SUB MLINIT (MLPARM) STATIC
  102.     DEF SEG = 0
  103.     IF COMPUTER.TYPE = 1 _
  104.        GOTO 10
  105.     IF NOT MLCOM THEN _
  106.        IF NETWORK.TYPE <> 1 THEN _
  107.           GOTO 10
  108.     MULTI.LINK.PRESENT = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  109.     IF MULTI.LINK.PRESENT = 0 THEN _
  110.        GOTO 10
  111.     ON MLPARM GOSUB 30,20,60,10
  112. 10  DEF SEG
  113.     EXIT SUB
  114. 20  IF DOORS.TERMINAL.TYPE < 1 THEN _
  115.        RETURN
  116.     DEF SEG = MULTI.LINK.PRESENT
  117.     GOSUB 60
  118. ' **************     MLUTIL BAUD n (where n = BAUD.TEST)  ******
  119.     AX = &H600
  120.     BX = BAUD.TEST   ' Tell ML the baud rate
  121.     GOSUB 80
  122. ' **************     MLUTIL TERM n (where n = DOORS.TERMINAL.TYPE) ****
  123.     AX = &H700 + DOORS.TERMINAL.TYPE
  124.     GOSUB 80         ' Tell ML the terminal type
  125. ' *********          MLINK /port       ***********
  126. '                    ' Tell ML the communications port
  127.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(COM.PORT$,1)) - 48
  128. ' ************       MLUTIL SCMON       *************
  129.     AX = &HB01
  130.     BX = 0           ' Tell ML to start monitoring the carrier
  131.     GOSUB 80
  132.     RETURN
  133. ' **************     MLUTIL CCMON       ***************
  134. 30  AX = &HB00       ' Turn off ML's carrier monitoring.
  135.     BX = 0
  136.     GOSUB 80
  137. ' **************     MLUTIL TERM 1       *************
  138.     AX = &H701       ' Change terminal type to ML type 1.
  139.     BX = 0
  140.     GOSUB 80
  141. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  ******
  142. ' *******            port = 0 if ML 4.00 or greater           ******
  143.     DEF SEG = MULTI.LINK.PRESENT
  144.     MULTI.LINK.COM.PORT = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  145.     MULTI.LINK.VERSION = PEEK(&H1) + 256 * PEEK(&H2)
  146.     IF PEEK(MULTI.LINK.COM.PORT) = &H1 OR _
  147.        PEEK(MULTI.LINK.COM.PORT) = &H2 THEN _
  148.        IF MULTI.LINK.VERSION > 5000 THEN _
  149.           POKE (MULTI.LINK.COM.PORT),&H0 _
  150.        ELSE POKE (MULTI.LINK.COM.PORT),&H9
  151. ' **********         MLUTIL ENQ         **********
  152.     AX = &H1        ' Tell ML to conditional enque on the comm. port
  153.     GOSUB 70
  154. ' **********         MLUTIL BAUD 19200      *********
  155.     AX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  156.     BX = 19200
  157.     GOSUB 80
  158.     RETURN
  159. ' **********         MLUTIL DEQ         *********
  160. 60 AX = &H100        ' Tell ML to unconditionally deque the comm. port
  161. 70 BX = -4
  162.    IF COM.PORT$ = "COM2" THEN _
  163.       BX = -3
  164.    IF COM.PORT$ = "COM0" THEN _
  165.       RETURN
  166. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  *******
  167. 80 CALL RBBSML(AX,BX)
  168.    RETURN
  169.    END SUB
  170. 90 '  $SUBTITLE: 'GOIDLE - release control when waiting'
  171. '  $PAGE
  172. '
  173. '  NAME    -- GOIDLE
  174. '
  175. '  INPUTS  -- MLCOM
  176. '             NETWORK.TYPE
  177. '
  178. '  OUTPUTS --  NONE
  179. '
  180. '  PURPOSE --  To relinquish control when RBBS-PC is waiting for
  181. '              input from the communications port
  182. '
  183.       SUB GOIDLE STATIC
  184.    IF MLCOM OR NETWORK.TYPE = 1 THEN _
  185.       CALL MLINIT(5) : _
  186.       EXIT SUB
  187.    CALL GIVEBACK
  188.    END SUB
  189. 97 '  $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright'
  190. '  $PAGE
  191. '
  192. '  NAME    -- COPYWRIT
  193. '
  194. '  INPUTS  --  NONE
  195. '
  196. '  OUTPUTS --  NONE
  197. '
  198. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  199. '
  200.       SUB COPYWRIT STATIC
  201.    A = (RECYCLE.TO.DOS OR DEBUG OR NODE.RECORD.INDEX > 2)
  202.    IF A THEN _
  203.       EXIT SUB
  204.    WIDTH 80
  205.    REDIM A$(11)
  206.    A$(1) = "If you use RBBS-PC CPC17.2A, please consider contributing to"
  207.    A$(2) = ""
  208.    A$(3) = "             Capital PC Software Exchange"
  209.    A$(4) = "                 Post Office Box 6128"
  210.    A$(5) = "            Silver Spring, Maryland  20906"
  211.    A$(6) = ""
  212.    A$(7) = "You are free to copy and share RBBS-PC CPC17.2A provided"
  213.    A$(08)= "  1.  This program is distributed unmodified"
  214.    A$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  215.    A$(10)= "  3.  This notice is not bypassed or removed."
  216.    CLS
  217.    KEY OFF
  218.    LOCATE ,,0
  219.    SNOOP = -1
  220.    LOCAL.USER = -1
  221.    CALL LPRNT(SPACE$(60) + "tm",1)
  222.    CALL LPRNT(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  223.    CALL SKIPLINE(1)
  224.    CALL LPRNT(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  225.    CALL SKIPLINE (1)
  226.    CALL LPRNT(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  227.    FOR I = 1 TO 10
  228.       CALL LPRNT(SPACE$(5) + CHR$(186) + "    " + A$(I) + SPACE$(62 - LEN(A$(I))) + CHR$(186),1)
  229.    NEXT
  230.    CALL LPRNT(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  231.    CALL LPRNT(SPACE$(5) + "Copyright (c) 1983-88 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  232.    CALL DELAYIT (8)
  233.    SNOOP = 0
  234.    END SUB
  235. 101 ' $SUBTITLE: 'GETCOMND - sub to get command from command line'
  236. ' $PAGE
  237. '
  238. '  NAME    -- GETCOMND
  239. '
  240. '  INPUTS  --     PARAMETER                    MEANING
  241. '             CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE TO
  242. '                                  USE AS A MODEL WHEN CREATING THE
  243. '                                  .DEF FILE NAME TO BE USED BY THIS
  244. '                                  COPY OF RBBS-PC.
  245. '
  246. '             COMMAND LINE         COMMAND LINE USED TO INVOKE
  247. '                                  RBBS-PC IN THE FORM:
  248. '
  249. '       RBBS-PC.EXE x filename DEBUG /time /baud /reliable
  250. '
  251. '   WHERE THE OPTIONAL PARAMETERS ARE:
  252. '
  253. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  254. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  255. ' DEBUG    IS A DEBUGGING SWITCH
  256. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  257. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  258. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  259. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  260. '             PROGRAM
  261. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  262. '
  263. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  264. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  265. '
  266. '  OUTPUTS -- CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE FOR
  267. '                                  THIS COPY OF RBBS-PC TO USE
  268. '             NODE.RECORD.INDEX    RECORD NUMBER WITHIN THE
  269. '                                  MESSAGES FILE FOR THIS "NODE"
  270. '                                  (RANGE IS 2 TO 36)
  271. '
  272. '  PURPOSE --  To get node id from command line and determine if rbbs
  273. '              is being run as a door
  274. '
  275.       SUB GETCOMND (PASSED.DEBUG,NETIME$,NETBAUD$,NETRELIABLE$) STATIC
  276.       STATIC DEBUG
  277. '
  278. '
  279. ' *  GET NODE ID FROM COMMAND LINE
  280. '
  281. '
  282.       PM$ = COMMAND$
  283.       CALL ALLCAPS(PM$)
  284.       IF INSTR(PM$,"/") = 0 THEN _
  285.          GOTO 103
  286. '
  287. '
  288. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
  289. '
  290. '
  291.       CMD.LINE$ = MID$(PM$,INSTR(PM$,"/"))
  292.       PM$ = LEFT$(PM$,INSTR(PM$,"/") - 1)
  293.       A = 0
  294.       FOR X = 1 TO LEN(CMD.LINE$)
  295.           IF MID$(CMD.LINE$,X,1) = "/" THEN _
  296.              A = A + 1 : _
  297.              WORK.ARA$(A) = "" _
  298.           ELSE WORK.ARA$(A) = WORK.ARA$(A) + MID$(CMD.LINE$,X,1)
  299.       NEXT
  300.       NETIME$ = WORK.ARA$(1)
  301.       IF A > 1 THEN _
  302.          NETBAUD$ = WORK.ARA$(2)
  303.       IF A > 2 THEN _
  304.          NETRELIABLE$ = WORK.ARA$(3)
  305.       CALL TRIM(NETIME$)
  306.       CALL TRIM(NETBAUD$)
  307.       CALL TRIM(NETRELIABLE$)
  308. 103   A = INSTR(PM$,"DEBUG")
  309.       IF A > 0 THEN _
  310.          DEBUG = -1 : _
  311.          PM$ = LEFT$(PM$,A - 1) + _
  312.                RIGHT$(PM$,LEN(PM$) - A - 4)
  313.       PASSED.DEBUG = DEBUG
  314.       A = INSTR(PM$,"LOCAL")
  315.       IF A > 0 THEN _
  316.          COM.PORT$ = "COM0" : _
  317.          PM$ = LEFT$(PM$,A - 1) + _
  318.                RIGHT$(PM$,LEN(PM$) - A - 4)
  319.       IF LEN(PM$) = 0 THEN _
  320.          PM$ = "-"
  321.       NODE.RECORD.INDEX = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(PM$,1))
  322.       IF NODE.RECORD.INDEX < 2 THEN _
  323.          NODE.RECORD.INDEX = 2
  324.       NODE.ID$ = MID$(STR$(NODE.RECORD.INDEX-1),2)
  325.       IF NODE.RECORD.INDEX > 10 THEN _
  326.          NODE.FILE.ID$ = LEFT$(PM$,1) _
  327.       ELSE NODE.FILE.ID$ = NODE.ID$
  328.       IF NODE.ID$ <> "1" THEN _
  329.          LIBRARY.NODE.ID$ = NODE.FILE.ID$
  330.       IF LEN(PM$) > 2 AND MID$(PM$,2,1) = " " THEN _
  331.          CONFIG.FILENAME$ = MID$(PM$,3)_
  332.       ELSE MID$(CONFIG.FILENAME$,5,1) = PM$
  333.       ORIG.CONFIG$ = CONFIG.FILENAME$
  334.       END SUB
  335. 105 ' $SUBTITLE: 'TRIM - sub to eliminate leading/trailing blanks'
  336. ' $PAGE
  337. '
  338. '  NAME    -- TRIM
  339. '
  340. '  INPUTS  --  PARAMETER                    MEANING
  341. '              TRIM.PARM$           STRING THAT IS TO HAVE LEADING
  342. '                                   AND TRAILING BLANKS ELIMINATED FROM
  343. '
  344. '  OUTPUTS --  TRIM.PARM$           STRING WITH NO LEADING OR TRAILING
  345. '                                   BLANKS
  346. '
  347. '  PURPOSE --  To strip leading and trailing blanks
  348. '
  349.       SUB TRIM (TRIM.PARM$) STATIC
  350.       L = INSTR(TRIM.PARM$," ")
  351.       IF L < 1 THEN _
  352.          EXIT SUB
  353.       IF L = 1 THEN _
  354.          WHILE LEFT$(TRIM.PARM$,1) = " " : _
  355.             TRIM.PARM$ = RIGHT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1) : _
  356.          WEND
  357.       CALL TRIMTRAIL (TRIM.PARM$," ")
  358.       END SUB
  359. '
  360. 107 '  $SUBTITLE: 'TRIMTRAIL - sub to trim off trailing characters'
  361. '  $PAGE
  362. '
  363. '  NAME    --  TRIMTRAIL
  364. '
  365. '  INPUTS  --  PARAMETER           MEANING
  366. '              TRIM.PARM$  TIME IN SECONDS AFTER MIDNIGHT TO WAIT
  367. '                          BEFORE DISPLAYING
  368. '              TRIM.THIS$  WHAT CHARACTER TO TRIM OFF END
  369. '
  370. '  OUTPUTS --  NONE
  371. '
  372. '  PURPOSE --  To display RBBS-PC's sysop menu on the local screen
  373. '
  374.       SUB TRIMTRAIL (TRIM.PARM$,TRIM.THIS$) STATIC
  375.       WHILE RIGHT$(TRIM.PARM$,1) = TRIM.THIS$
  376.          TRIM.PARM$ = LEFT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1)
  377.       WEND
  378.       END SUB
  379. '
  380. 109 '  $SUBTITLE: 'VARINIT - subroutine to initialize system variables'
  381. '  $PAGE
  382. '
  383. '  NAME    --  VARINIT
  384. '
  385. '  INPUTS  --  PARAMETER           MEANING
  386. '              NONE
  387. '
  388. '  OUTPUTS --  NONE
  389. '
  390. '  PURPOSE --  To initialize system variable
  391. '
  392.       SUB VARINIT STATIC
  393.     ACKNOWLEDGE$ = CHR$(6)
  394.     ACKC$ = "C" + _
  395.             ACKNOWLEDGE$
  396.     ACTIVE.MENU$ = "B"
  397.     ACTIVE.MESSAGE$ = CHR$(225)
  398.     BACKSPACE$ = CHR$(8) + _
  399.                  CHR$(32) + _
  400.                  CHR$(8)
  401.     BACK.ARROW$ = CHR$(29) + _
  402.                   CHR$(32) + _
  403.                   CHR$(29)
  404.     BELL.RINGER$ = CHR$(7)
  405.     BULLETIN.MENU$ = ""
  406.     C.L = 24
  407.     CANCEL$ = CHR$(24)
  408.     COLOR.RESET$ = CHR$(27) + _
  409.                    "[00;37;40m"
  410.     CONFIG.FILENAME$ = "RBBS-PC.DEF"
  411.     CARRIAGE.RETURN$ = CHR$(13)
  412.     DELETED.MESSAGE$ = CHR$(226)
  413.     DOS.VERSION = 2
  414.     END.TRANSMISSION$ = CHR$(4)
  415.     ESCAPE$ = CHR$(27)
  416.     EXPECT.ACTIVE.MODEM = 0
  417.     FALSE = 0
  418.     F1.KEY = 59
  419.     F10.KEY = 68
  420.     GRN$ = "MAIN"
  421.     CALL SETHILITE (TRUE)
  422.     HOME.CONFERENCE$ = ""
  423.     IN.CONF.MENU = -1
  424.     LAST.COMMAND$ = "M "                                             ' KG060701
  425.     LIMIT.MINUTES.PER.SESSION! = 0
  426.     LINE.FEED$ = CHR$(10)
  427.     LINE.FEEDS = NOT FALSE
  428.     LINEEDIT.CHK$ = CHR$(9) + _
  429.                     LINE.FEED$ + _
  430.                     CHR$(11) + _
  431.                     CHR$(12) + _
  432.                     CHR$(127) + _
  433.                     CHR$(8) + _
  434.                     BELL.RINGER$ + _
  435.                     CHR$(26) + _
  436.                     CHR$(227)
  437.     LINEMES$ = SPACE$(78)          ' fixed length string workspace
  438.     LOCK.STATUS$ = "UM UU UB UD"
  439.     MENU.INDEX = 2
  440.     NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  441.     NO.ADVANCE = FALSE
  442.     PAGE.LENGTH = 23
  443.     PARSE.OFF = FALSE
  444.     PRESS.ENTER$ = " (Press [ENTER] to quit)"
  445.     PRESS.ENTER.EXPERT$ = " ([ENTER] quits)"
  446.     PRESS.ENTER.NOVICE$ = PRESS.ENTER$
  447.     PRIVATE.DOOR = FALSE
  448.     RIGHT.MARGIN = 72
  449.     RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + _
  450.                         LINE.FEED$
  451.     SMART.TABLE$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  452.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI"
  453.     START.OF.HEADER$ = CHR$(1)
  454.     TIME.LOGGED.ON$ = SPACE$(8)
  455.     TRUE = NOT FALSE
  456.     UPINC = -1
  457.     XOFF$ = CHR$(19)
  458.     XON$ = CHR$(17)
  459.     INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$
  460.     OPTION.END$ = RETURN.LINE.FEED$ + " ,("
  461.     CRLF$ = CARRIAGE.RETURN$ + LINE.FEED$
  462.     LG$(1) = "Registration Check Failed"
  463.     LG$(2) = "Sysop name attempted"
  464.     LG$(3) = "Locked out attempt"
  465.     LG$(4) = "Password Attempt Failed"
  466.     LG$(5) = "Auto Lockout done"
  467.     LG$(6) = "Name in use on another Node!"
  468.     LG$(7) = ""
  469.     LG$(8) = "Locked reason read!"
  470.     LG$(9) = "Expired Registration"
  471.     END SUB
  472. '
  473. 112 ' $SUBTITLE: 'SYSMENU - sub to display RBBS-PC SYSOP menu'
  474. '  $PAGE
  475. '
  476. '  NAME    --  SYSMENU
  477. '
  478. '  INPUTS  --  PARAMETER           MEANING
  479. '                DELAY!    TIME IN SECONDS AFTER MIDNIGHT TO WAIT
  480. '                            BEFORE DISPLAYING
  481. '
  482. '  OUTPUTS --  NONE
  483. '
  484. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  485. '
  486.     SUB SYSMENU STATIC
  487.     DELAY! = 0
  488.     LOCAL.USER = TRUE
  489.     SNOOP = TRUE
  490.     NON.STOP = TRUE
  491.     SUBROUTINE.PARAMETER = 1
  492.     WHILE SUBROUTINE.PARAMETER = 1
  493.        CALL CHECKTIM (DELAY!)
  494.     WEND
  495.     CLS
  496.     STOP.INTERRUPTS = TRUE
  497.     BYPASS.TIME.CHECK = TRUE
  498.     CALL BUFFILE ("MENU0",X)
  499.     NON.STOP = FALSE
  500.     BYPASS.TIME.CHECK = FALSE
  501.     LOCAL.USER = FALSE
  502.     IF NOT OK THEN _
  503.        CALL LPRNT("MENU0 not on default drive",1)
  504.     LOCATE 2,18
  505.     CALL LPRNT(LEFT$(VERSION.ID$,8),0)
  506.     LOCATE 2,42
  507.     CALL LPRNT(NODE.ID$,0)
  508.     LOCATE 2,60
  509.     X$ = DATE$
  510.     CALL LPRNT(LEFT$(X$,6) + RIGHT$(X$,2),0)
  511.     LOCATE 2,74
  512.     CALL LPRNT(LEFT$(TIME$,5),0)
  513.     IF FMS.DIRECTORY$ <> "" THEN _
  514.        LOCATE 6,76 : _
  515.        CALL LPRNT("YES",0)
  516.     IF EXTENDED.LOGGING THEN _
  517.        LOCATE 8,76 : _
  518.        CALL LPRNT("YES",0)
  519.     IF FOSSIL THEN _
  520.        LOCATE 10,76 : _
  521.        CALL LPRNT("YES",0)
  522.     LOCATE 12,75 : _
  523.     CALL LPRNT(COM.PORT$,0)
  524.     LOCATE 14,75
  525.     CALL LPRNT (STR$(CINT(FRE("A")/1024)) + "k",0)
  526.     IF DEBUG THEN _
  527.        LOCATE 22,76 : _
  528.        CALL LPRNT("Yes",0)
  529.     END SUB
  530. '
  531. 120 '  $SUBTITLE: 'EDITDEF - sub to edit config parameters'
  532. '  $PAGE
  533. '
  534. '  NAME    -- EDITDEF
  535. '
  536. '  INPUTS  --     PARAMETER                    MEANING
  537. '
  538. '  OUTPUTS --                          OUTPUT STRING
  539. '
  540. '  PURPOSE -- Interpretes and adjusts stored configuration parameters
  541. '
  542.       SUB EDITDEF STATIC
  543.       ALL.OPTS$ = MAIN.COMMANDS$ + _
  544.                   FILE.COMMANDS$ + _
  545.                   UTIL.COMMANDS$ + _
  546.                   LIBRARY.COMMANDS$ + _
  547.                   GLOBAL.COMMANDS$ + _
  548.                   SYSOP.COMMANDS$
  549.       HELP.EXTENSION$ = "." + _
  550.                         HELP.EXTENSION$
  551.       BEG.MAIN = 1
  552.       BEG.FILE = LEN(MAIN.COMMANDS$) + BEG.MAIN
  553.       BEG.UTIL = LEN(FILE.COMMANDS$) + BEG.FILE
  554.       BEG.LIBRARY = LEN(UTIL.COMMANDS$) + BEG.UTIL
  555.       HELP$(3) = HELP.PATH$ + _
  556.                  HELP$(3)
  557.       HELP$(4) = HELP.PATH$ + _
  558.                  HELP$(4)
  559.       HELP$(7) = HELP.PATH$ + _
  560.                  HELP$(7)
  561.       HELP$(9) = HELP.PATH$ + _
  562.                  HELP$(9)
  563.       CALL BRKFNAME (WELCOME.FILE$,WELCOME.FILE.DRV.PATH$,PREFIX$,_
  564.                      EXTENSION$,TRUE)
  565.      CALL ASCCODES ("[","]",DEFAULT.LINE.ACK$)
  566.      CALL ASCCODES ("[","]",HOST.ECHO.ON$)
  567.      CALL ASCCODES ("[","]",HOST.ECHO.OFF$)
  568.      CALL ASCCODES ("[","]",EMPHASIZE.OFF.DEF$)
  569.      CALL ASCCODES ("[","]",EMPHASIZE.ON.DEF$)
  570.      DR.1$ = FG.1.DEF$
  571.      DR.2$ = FG.2.DEF$
  572.      DR.3$ = FG.3.DEF$
  573.      DR.4$ = FG.4.DEF$
  574.      IF SUBROUTINE.PARAMETER = -62 THEN _
  575.         EXIT SUB
  576.      LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1")
  577.      IF LOCAL.USER.MODE THEN _
  578.         RECYCLE.TO.DOS = TRUE
  579.      ECHOER$ = DEFAULT.ECHOER$
  580.      IF LEN(SCREEN.OUT.MSG$) < 2 THEN _
  581.         SCREEN.OUT.MSG$ = START.OF.HEADER$
  582.      SMART.TEXT$ = CHR$(SMART.TEXT)
  583.      IF MAX.WORK.VAR < 13 THEN _
  584.         MAX.WORK.VAR = 13
  585. '
  586. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***
  587. '
  588.     IF MAIN.FMS.DIRECTORY$ <> "" THEN _
  589.        FMS.DIRECTORY$ = DIRECTORY.PATH$ + _
  590.                         MAIN.FMS.DIRECTORY$ + _
  591.                         "." + _
  592.                         MAIN.DIRECTORY.EXTENTION$ : _
  593.        ACTIVE.FMS.DIRECTORY$ = FMS.DIRECTORY$ : _
  594.        LIBRARY.DIRECTORY$ = LIBRARY.DIRECTORY.PATH$ + _
  595.                             MAIN.FMS.DIRECTORY$ + _
  596.                             "." + _
  597.                             LIBRARY.DIRECTORY.EXTENTION$
  598.     UPCAT.HELP$ = HELP.PATH$ + _
  599.                   UPCAT.HELP$ + _
  600.                   HELP.EXTENSION$
  601.     IF SUBDIR.COUNT < 1 THEN _
  602.        GOTO 123
  603.     FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
  604.        INPUT #2,SUBDIR$
  605.        IF RIGHT$(SUBDIR$,1) <> "\" THEN _
  606.          SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + _
  607.                                  "\" _
  608.        ELSE SUBDIR$(SUBDIR.INDEX) = SUBDIR$
  609.     NEXT
  610.     GOTO 125
  611. 123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
  612.        SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + _
  613.                                ":"
  614.     NEXT
  615.     SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
  616. '
  617. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ***
  618. '
  619. 125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$
  620.     SUBDIR.COUNT = SUBDIR.COUNT + 1
  621.     IF UPLOAD.TO.SUBDIR THEN _
  622.        SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + _
  623.                                "\" _
  624.     ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
  625.                                  ":"
  626.     UPLOAD.DIRECTORY$ = UPLOAD.DIRECTORY$ + _
  627.                         "." + _
  628.                         MAIN.DIRECTORY.EXTENTION$
  629.     CALL CHKNARY (SUBDIR$(SUBDIR.COUNT),SUBDIR$(),SUBDIR.COUNT-1,FOUND)
  630.     CAN.DOWNLOAD.FROM.UP = (FOUND > 0)
  631.     UPLOAD.DIRECTORY$ = UPLOAD.PATH$ + _
  632.                         UPLOAD.DIRECTORY$
  633. 126 CLOSE #2
  634.     IF LIBRARY.DRIVE$ <> "" THEN _
  635.        LIBRARY.TYPE = 1
  636.     SUBROUTINE.PARAMETER = -10
  637.     CALL CARRIER
  638.     IF SUBROUTINE.PARAMETER = -1 THEN _
  639.        IF LIBRARY.DRIVE$ <> "" THEN _
  640.           CALL CHANGEDIR (LIBRARY.DRIVE$ + _
  641.                          "\") : _
  642.           CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  643.                         LIBRARY.NODE.ID$ + _
  644.                         "DK*.ARC") : _
  645.                         EC = 0
  646. '
  647. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***
  648. '
  649. 128 IF NETWORK.TYPE = 2 THEN _
  650.        CN$ = SPACE$(535) : _
  651.        CALL INITIO(A)
  652.        END SUB
  653. '
  654. 129 '  $SUBTITLE: 'ASCCODES - subrotuine to allow any ASCII codes'
  655. '  $PAGE
  656. '
  657. '  NAME    -- ASCCODES
  658. '
  659. '  INPUTS  --     PARAMETER                    MEANING
  660. '                 LEFT.PAREN$           MARKS BEGINNING OF #
  661. '                 RIGHT.PAREN$          MARKS END OF #
  662. '                 STRNG$                INPUT STRING
  663. '
  664. '  OUTPUTS --    STRNG$                OUTPUT STRING
  665. '
  666. '  PURPOSE -- To allow a config string to have any ascii values.
  667. '             characters not enclosed taken as is.  Enclosed
  668. '             characters interpreted as value of ascii code.
  669. '             (e.g. "123[32]4" is interpreted as "123 4").
  670. '
  671.     SUB ASCCODES (LEFT.PAREN$,RIGHT.PAREN$,STRNG$) STATIC
  672.     IF LEN(STRNG$) < 1 THEN _
  673.        EXIT SUB
  674.     STRT = 1
  675.     L = LEN(STRNG$)
  676.     B$ = STRNG$ + _
  677.          LEFT.PAREN$
  678.     X = INSTR(B$,LEFT.PAREN$)
  679.     NEW.STRNG$ = ""
  680.     WHILE STRT <= L
  681.        NEW.STRNG$ = NEW.STRNG$ + _
  682.                     MID$(B$,STRT,X - STRT)
  683.        Y = INSTR(X,B$,RIGHT.PAREN$)
  684.        IF Y > 0 THEN _
  685.           K = VAL(MID$(B$,X + 1,Y - X - 1)) : _
  686.           NEW.STRNG$ = NEW.STRNG$ + _
  687.                        CHR$(K) : _
  688.           STRT = Y + 1 _
  689.        ELSE NEW.STRNG$ = NEW.STRNG$ + _
  690.                          MID$(B$,X,L + 1 - X) : _
  691.             STRT = L + 1
  692.        X = INSTR(STRT,B$,LEFT.PAREN$)
  693.     WEND
  694.     STRNG$ = NEW.STRNG$
  695.     END SUB
  696. 200 ' $SUBTITLE: 'ANSWERIT - sub to establish connection'
  697. ' $PAGE
  698. '
  699. '  NAME    -- ANSWERIT
  700. '
  701. '  INPUTS  --     PARAMETER                    MEANING
  702. '            SUBROUTINE.PARAMETER = 1   WAIT FOR PHONE TO RING
  703. '                                 = 2   CONTINUE LOOKING FOR CONNECT
  704. '                                 = 3   RENTRY AFTER FUNCTION KEY
  705. '                                 = 4   GO ON LINE IMMEDIATELY
  706. '            BG                         LOCAL DISPLAY'S BACKGROUND
  707. '            BORDER                     LOCAL DISPLAY'S BORDER COLOR
  708. '            COM.PORT$                  COMMUNICATIONS PORT NAME
  709. '            COMPUTER.TYPE              TYPE OF COMPUTER RUNNING ON
  710. '            DUMB.MODEM                 NON-HAYES TYPE MODEM FLAG
  711. '            EXTENDED.LOGGING           EXTENDED CALLERS LOG FLAG
  712. '            FG                         LOCAL DISPLAY'S FOREGROUND
  713. '            MODEM.ANSWER.COMMAND$      COMMAND TO ANSWER PHONE
  714. '            MODEM.CONTROL.REGISTER     LOCATION OF MODEM CNTRL. REG
  715. '            MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS
  716. '            MODEM.INIT.BAUD$           BAUDE AT WHICH TO OPEN COMM.
  717. '            MODEM.RESET.COMMAND$       COMMAND TO RESET THE MODEM
  718. '            MODEM.STATUS.REGISTER      LOCATION OF MODEM STATUS REG
  719. '            PRINTER                    FLAG TO PRINT ON LOCAL PRT.
  720. '            REQUIRED.RINGS             NUMBER OF RINGS TO ANSWER ON
  721. '            SNOOP                      FLAG TO DISPLAY ON LOCAL PC
  722. '            SYSOP.NEXT                 FLAG TO GIVE SYSOP CONTROL
  723. '
  724. '  OUTPUTSS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  725. '              EIGHT.BIT                  PARITY INDICATOR
  726. '              RELIABLE.MODE              INDICATES MODEM-SUPPLIED
  727. '                                         "ERROR-FREE" PROTOCOL ACTIVE
  728. '              SUBROUTINE.PARAMETER = 1   CARRIER DETECT FOUND (I.E.
  729. '                                         MODEM AUTO-ANSWERED).
  730. '                                   = 2   ANSWERED THE PHONE AND
  731. '                                         CARRIER DETECT OCCURRED.
  732. '                                   = 3   SYSOP HIT "ESC" KEY ON THE
  733. '                                         LOCAL KEYBOARD.
  734. '                                   = 4   ANSWERED THE PHONE BUT NO
  735. '                                         CARRIER WAS DETECTED.
  736. '                                   = 5   COMM. BUFFER OVERFLOW.
  737. '                                   = 6   FUNCTION KEY PRESSED ON THE
  738. '                                         LOCAL KEYBOARD.
  739. '
  740. '  PURPOSE -- To detect incoming call and establish connection.
  741. '
  742.       SUB ANSWERIT STATIC
  743.       EC = 0
  744.       RELIABLE.MODE = FALSE
  745.       FF = SUBROUTINE.PARAMETER
  746.       SUBROUTINE.PARAMETER = 0
  747.       ON FF GOTO 201,324,245,320
  748. '
  749. '
  750. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS
  751. '
  752. '
  753. 201 SUBROUTINE.PARAMETER = -10
  754.     CALL CARRIER
  755.     IF SUBROUTINE.PARAMETER = 0 THEN _
  756.        GOTO 210                                                      ' KG061103
  757. '
  758. '
  759. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY
  760. '
  761. '
  762.     IF FOSSIL THEN _
  763.        STATE% = 0 : _
  764.        CALL FOSDTR(COMPORT%,STATE%) _
  765.     ELSE OUT MODEM.CONTROL.REGISTER,&H4
  766.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  767. '
  768. '
  769. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT
  770. '
  771. '
  772.     IF FOSSIL THEN _
  773.        STATE% = 1 : _
  774.        CALL FOSDTR(COMPORT%,STATE%) _
  775.     ELSE OUT MODEM.CONTROL.REGISTER,&H0
  776.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  777. 210 IF PRIVATE.DOOR THEN _
  778.        CALL TRANSFER : _
  779.        GOTO 235
  780.     CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  781. 220 CALL AMORPMTD                                                    ' KG061203
  782. 230 IF PRINTER THEN _
  783.        CALL PRINTIT (" RBBS-PC " + VERSION.ID$ + " Node " + _
  784.                     NODE.ID$ + " up " + TIM$ + " on " + DATE$)
  785. 235 EIGHT.BIT = TRUE
  786.     SUBROUTINE.PARAMETER = -10
  787.     CALL CARRIER
  788.     IF SUBROUTINE.PARAMETER = 0 AND _
  789.        EXIT.TO.DOORS THEN _
  790.        CALL READPROF : _
  791.        SUBROUTINE.PARAMETER = 1 : _
  792.        GOTO 335
  793.     IF SUBROUTINE.PARAMETER = 0 AND _
  794.        EXPECT.ACTIVE.MODEM THEN _
  795.        BAUD.TEST = VAL(NETBAUD$) : _
  796.        CALL TESTREL (NETRELIABLE$) : _
  797.        GOTO 328
  798.     IF EXPECT.ACTIVE.MODEM OR _
  799.        EXIT.TO.DOORS THEN _
  800.        SUBROUTINE.PARAMETER = 4 : _
  801.        EXIT SUB
  802.     IF SUBROUTINE.PARAMETER = 0 THEN _
  803.        GOTO 324
  804.     PCJR = FALSE
  805.     IF COMPUTER.TYPE = 2 AND _
  806.        COM.PORT$ = "COM1" AND _
  807.        MODEM.STATUS.REGISTER = 1022 THEN _
  808.        MODEM.GO.OFFHOOK.COMMAND$ = CHR$(14) + _
  809.                                    "P" : _
  810.        PCJR = TRUE
  811.     CALL SYSMENU
  812.     IF PCJR THEN _
  813.        A$ = CHR$(14) + _
  814.             "I" _
  815.     ELSE A$ = MODEM.RESET.COMMAND$
  816.     CALL MODEMPUT (A$)
  817.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  818.     IF PCJR THEN _
  819.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  820.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  821.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  822.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  823.     ELSE A$ = MODEM.INIT.COMMAND$
  824.     CALL MODEMPUT (A$)
  825.     IF PCJR THEN _
  826.        A$ = CHR$(14) + _
  827.             "F 4" : _
  828.        CALL MODEMPUT (A$)
  829.     RINGBACK = FALSE
  830.     LOCATE 16,55
  831.     IF REQUIRED.RINGS = 0 THEN _
  832.        CALL LPRNT("WAITING FOR CARRIER",0) : _
  833.        GOTO 237
  834.     IF MID$(MODEM.INIT.COMMAND$, _
  835.           INSTR(MODEM.INIT.COMMAND$,"S0") + 3,3) = "255" THEN _
  836.        CALL LPRNT("RING BACK SYSTEM",0) : _
  837.        RINGBACK = TRUE : _
  838.        GOTO 236
  839.     CALL LPRNT(" WAITING FOR RING ",0)                               ' RS060402
  840. 236 LOCATE 16,76 : _
  841.     CALL LPRNT(MID$(STR$(REQUIRED.RINGS),2),0)
  842. 237 LOCATE 18,76
  843.     IF DOSANSI THEN _
  844.        CALL LPRNT(ESCAPE$ + "[05m" + "YES" + ESCAPE$ + "[00m",0) _
  845.     ELSE CALL LPRNT ("YES",0)
  846.     COLOR FG,BG,BORDER
  847.     LOCATE 20,56
  848. '
  849. '
  850. ' *  GET READY TO ANSWER INCOMMING CALL:
  851. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
  852. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
  853. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
  854. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM INIT COMMAND.
  855. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
  856. ' *           FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK).
  857. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
  858. '
  859. '
  860.     QQ = 255
  861.     I = INSTR(MODEM.INIT.COMMAND$,"S0")
  862.     IF I = 0 OR PCJR THEN _
  863.        GOTO 239
  864.     IF VAL(MID$(MODEM.INIT.COMMAND$,I + 3,3)) = 255 THEN _
  865.        QQ = 0 : _
  866.        BLK = QQ
  867.     CALL FINDTIME (TCA!)
  868.     SUBROUTINE.PARAMETER = 1
  869.     CALL LINE25
  870.     RING.ANSWER = TRUE
  871.     IF RINGBACK THEN _
  872.        RING.ANSWER = FALSE
  873. 239 RINGBACK.WAIT.STARTED! = 0
  874.     IF RINGBACK THEN _
  875.        CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _
  876.        COLOR 7,0,0 _
  877.     ELSE COLOR FG,BG,BORDER
  878. 240 IF SYSOP.NEXT THEN _
  879.        SUBROUTINE.PARAMETER = 3 : _
  880.        EXIT SUB
  881. '
  882. '
  883. ' * WAIT FOR INCOMING CALLS
  884. '
  885. '
  886.     SCREEN.ALREADY.CLEARED = FALSE
  887. 245 CALL SETABORT (INACTIVE.DELAY!, (60 * RECYCLE.WAIT))
  888.     NO.CALL = TRUE
  889.     CALL FLUSHCOM (MODEM.RESPONSE$)
  890.     MODEM.RESPONSE$ = ""
  891. 247 IF INP(MODEM.STATUS.REGISTER) > 127 OR (NOT NO.CALL) THEN _
  892.        GOTO 274
  893.        CALL FINDFUNC
  894.        IF SUBROUTINE.PARAMETER < 0 THEN _
  895.           EXIT SUB
  896. 250    IF KEY.PRESSED$ = ESCAPE$ THEN _
  897.           SUBROUTINE.PARAMETER = 3 : _
  898.           EXIT SUB
  899.        IF KEY.PRESSED$ <> "" THEN _
  900.           GOTO 235
  901. 260    IF RINGBACK.WAIT.STARTED! > 0 THEN _
  902.           CALL FINDTIME (TI!) : _
  903.        IF ABS(TI! - RINGBACK.WAIT.STARTED!) > 45 THEN _
  904.           RINGBACK.WAIT.STARTED! = 0 : _
  905.           RING.BACK.COUNT = 0 : _
  906.           RING.ANSWER = FALSE: _
  907.           IF RINGBACK THEN _
  908.             LOCATE 20,56 : _
  909.             CALL LPRNT("Ringback timeout" + PAGING.PRINTER.SUPPORT$,1)
  910. 265    CALL FINDTIME (TI!)
  911.        IF ABS(TI! - TCA!) > 120 AND NOT SCREEN.ALREADY.CLEARED THEN _
  912.           LOCATE ,,0 : _
  913.           CLS : _
  914.           C.L = 1 : _
  915.           SCREEN.ALREADY.CLEARED = TRUE : _
  916.           CALL FINDTIME (TCA!)
  917.        IF TIME.TO.DROP.TO.DOS! > 0 AND _
  918.           OLD.DAT$ <> DATE$ AND _
  919.           TI! < 86340 AND _        ' Skip btw 23:59 and 00:00
  920.           TI! => TIME.TO.DROP.TO.DOS! THEN _
  921.              SUBROUTINE.PARAMETER = 7 : _
  922.              EXIT SUB
  923. 266    IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
  924.           REQUIRED.RINGS > 0 THEN _
  925.           GOTO 276
  926. 270    IF RECYCLE.WAIT > 0 THEN _
  927.           IF TI! > INACTIVE.DELAY! THEN _
  928.              SUBROUTINE.PARAMETER = 8 : _
  929.              EXIT SUB
  930.        CALL FLUSHCOM (X$)
  931.        IF LEN(X$) > 0 THEN _
  932.           MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$ : _
  933.           RING.DETECTED = (INSTR(MODEM.RESPONSE$,"RING") > 0) : _
  934.           CONNECT.DETECTED = (INSTR(MODEM.RESPONSE$,"ONNECT") > 0) : _
  935.           NO.CALL = (NOT RING.DETECTED) AND (NOT CONNECT.DETECTED)
  936.     IF RING.DETECTED AND REQUIRED.RINGS > 0 THEN _
  937.        MID$(MODEM.RESPONSE$, INSTR(MODEM.RESPONSE$,"RING")+1,1) = "A" : _
  938.        RING.DETECTED = FALSE : _
  939.        GOTO 276
  940.     CALL GOIDLE
  941.     GOTO 247
  942. 274 IF NOT RINGBACK THEN _
  943.        IF CONNECT.DETECTED THEN _
  944.           GOTO 321
  945.     IF REQUIRED.RINGS = 0 THEN _
  946.        CALL DELAYIT (3) : _
  947.        GOTO 321
  948. '
  949. '
  950. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR
  951. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --
  952. ' * "RING BACK."
  953. '
  954. '
  955. 276 CALL EOFCOMM (CHAR%)
  956.     IF CHAR% <> -1 THEN _
  957.        CALL FLUSHCOM(X$) : _
  958.        IF SUBROUTINE.PARAMETER = - 1 THEN _
  959.           EXIT SUB
  960.     IF PCJR THEN _
  961.        GOTO 320
  962.     A$ = MODEM.COUNT.RINGS.COMMAND$
  963.     CALL MODEMPUT (A$)
  964.     CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  965. 290 CALL FLUSHCOM(X$)
  966.     IF SUBROUTINE.PARAMETER = -1 THEN _
  967.        EXIT SUB
  968. 291 IF LEN(X$) = 0 THEN _
  969.        GOTO 310
  970. 292 IF INSTR(X$,"0") < 1 THEN _
  971.        GOTO 293
  972.     X$ = MID$(X$,INSTR(X$,"0"))
  973. 293 IF (NOT RING.ANSWER) AND (VAL(X$) < RING.BACK.COUNT) THEN _
  974.        RING.ANSWER = TRUE
  975. 300 RING.BACK.COUNT = VAL(X$)
  976.     Q = RING.BACK.COUNT + 1
  977.     IF (NOT RING.ANSWER) THEN _
  978.        Q = 0
  979. 305 LOCATE 20,56
  980.     CALL LPRNT(TIME$ + " Ring " + STR$(Q),0)
  981. 310 IF (RING.BACK.COUNT + 1 < REQUIRED.RINGS) OR _
  982.        (NOT RING.ANSWER) THEN _
  983.        GOTO 239
  984. 320 IF PCJR THEN _
  985.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  986.             "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  987.             "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  988.     ELSE A$ = MODEM.ANSWER.COMMAND$
  989.     CALL MODEMPUT (A$)
  990. '
  991. '
  992. ' *  TEST FOR CARRIER PRESENT
  993. '
  994. '
  995. 321 CALL SETABORT (CONNECT.DELAY!,MAX.CARRIER.WAIT)
  996.     IF CONNECT.DELAY! > 86399 THEN _
  997.        CONNECT.DELAY! = 86399
  998. 322 CALL FINDTIME (TI!)
  999. 323 SUBROUTINE.PARAMETER = -10
  1000.     CALL CARRIER
  1001.     IF SUBROUTINE.PARAMETER AND _
  1002.        TI! < CONNECT.DELAY! THEN _
  1003.        GOTO 322
  1004.     IF SUBROUTINE.PARAMETER THEN _
  1005.        SUBROUTINE.PARAMETER = 4 : _
  1006.        EXIT SUB
  1007.     CALL DELAYIT (3)
  1008. 324 SUBROUTINE.PARAMETER = 0
  1009.     IF TI! > CONNECT.DELAY! THEN _
  1010.        CALL UPDTCALR ("Connect timeout",1) : _
  1011.        SUBROUTINE.PARAMETER = 4 : _
  1012.        EXIT SUB
  1013. 325 CALL FLUSHCOM(X$)
  1014.     IF SUBROUTINE.PARAMETER = -1 THEN _
  1015.        IF EC = 69 THEN _
  1016.           SUBROUTINE.PARAMETER = 5 : _
  1017.        EXIT SUB
  1018.     MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$
  1019.     CALL FINDTIME (TI!)
  1020.     IF TI! > CONNECT.DELAY! THEN _
  1021.        CALL UPDTCALR ("Connect timeout",1) : _
  1022.        SUBROUTINE.PARAMETER = 4 : _
  1023.        EXIT SUB
  1024.     IF DUMB.MODEM THEN _
  1025.        BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _
  1026.        GOTO 327
  1027.     IF INSTR(MODEM.RESPONSE$,"FAST") THEN _
  1028.        BAUD.TEST = 19200 : _
  1029.        GOTO 327
  1030.     IF INSTR(MODEM.RESPONSE$,"ONNECT") THEN _
  1031.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONNECT") + 7)) : _
  1032.        GOTO 327
  1033.     IF INSTR(MODEM.RESPONSE$,"ONLINE") THEN _
  1034.        BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONLINE") + 7)) : _
  1035.        GOTO 327
  1036.     GOTO 324
  1037. 327 CALL TESTREL (MODEM.RESPONSE$)
  1038. 328 IF BAUD.TEST = 0 OR BAUD.TEST = 300 THEN _
  1039.        BAUD.TEST = 300 : _
  1040.        BPS = -1 : _
  1041.        GOTO 331
  1042.     IF BAUD.TEST = 1200 OR BAUD.TEST = 1275 THEN _
  1043.        BPS = -3 : _
  1044.        GOTO 331
  1045.     IF BAUD.TEST = 2400 THEN _
  1046.        BPS = -4 : _
  1047.        GOTO 331
  1048.     IF BAUD.TEST = 4800 OR BAUD.TEST = 9600 THEN _
  1049.        BPS = -4-(BAUD.TEST /4800) : _
  1050.        GOTO 331
  1051.     IF BAUD.TEST = 19200 THEN _
  1052.        BPS = -7 : _
  1053.        GOTO 331
  1054.     GOTO 324
  1055. 331 CALL SETBAUD
  1056.     SUBROUTINE.PARAMETER = 2
  1057. 335 DONT.WRITE = 0
  1058.     END SUB
  1059. 336 ' $SUBTITLE: 'TESTREL - Test for Reliable mode connection'
  1060. ' $PAGE
  1061. '
  1062. '  NAME    -- TESTREL
  1063. '
  1064. '  INPUTS  --     PARAMETER                    MEANING
  1065. '                 STRNG$                 String to check for reliable
  1066. '
  1067. '  OUTPUTS --    RELIABLE.MODE          Reliable mode indicator
  1068. '
  1069. '  PURPOSE -- To test for reliable connect
  1070. '
  1071.     SUB TESTREL (STRNG$) STATIC
  1072.     RELIABLE.MODE = FALSE
  1073.     IF STRNG$ = "" THEN _
  1074.        EXIT SUB
  1075.     IF INSTR(STRNG$,"REL") OR _
  1076.        INSTR(STRNG$,"R C") OR _       (ERROR CONTROL)
  1077.        INSTR(STRNG$,"ARQ") OR _
  1078.        INSTR(STRNG$,"LAP") OR _
  1079.        INSTR(STRNG$,"AFT") OR _
  1080.        INSTR(STRNG$,"MNP") THEN _
  1081.          RELIABLE.MODE = -1
  1082.     END SUB
  1083. 455 ' $SUBTITLE: 'BADCHAR - sub to check user names for bad characters'
  1084. ' $PAGE
  1085. '
  1086. '  NAME    -- BADCHAR
  1087. '
  1088. '  INPUTS  --     PARAMETER                    MEANING
  1089. '                PASSED.NAME$           USER NAME
  1090. '
  1091. '  OUTPUTS --    PASSED.NAME$           USER NAME WILL CONTAIN ""
  1092. '                                       IF BAD CHARACTERS FOUND
  1093. '
  1094. '  PURPOSE -- To check user names for invalid characters
  1095. '
  1096.     SUB BADCHAR (PASSED.NAME$) STATIC
  1097.     J = 1
  1098.     XX = LEN(PASSED.NAME$)
  1099. 457 IF J > XX THEN _
  1100.        EXIT SUB
  1101.     X$ = MID$(PASSED.NAME$,J,1)
  1102.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",X$) = 0 THEN _
  1103.        PASSED.NAME$ = "" : _
  1104.        EXIT SUB
  1105.     J = J + 1
  1106.     GOTO 457
  1107.     END SUB
  1108. 660 ' $SUBTITLE: 'PASSWRD - verify User and Message passwords'
  1109. ' $PAGE
  1110. '
  1111. '  NAME    -- PASSWRD
  1112. '
  1113. '  INPUTS  --     PARAMETER                    MEANING
  1114. '             SUBROUTINE.PARAMETER = 1  VERIFY USER PASSWORD
  1115. '                                  = 2  VERIFY MESSAGE PASSWORD
  1116. '                                  = 3  VERIFY MESSAGE PASSWORD
  1117. '                                  = 4  VERIFY MESSAGE PASSWORD
  1118. '                                  = 5  VERIFY MESSAGE PASSWORD
  1119. '
  1120. '  OUTPUTS -- PASSWORD.FAILED           SET TO 0 IF PASSED
  1121. '                                       SET TO -1 IF FAILED
  1122. '
  1123. '  PURPOSE -- To verify user and message passwords
  1124. '
  1125.     SUB PASSWRD STATIC
  1126.     EC = 0
  1127.     ON SUBROUTINE.PARAMETER GOTO 665,667,670,675,677
  1128. 665 IF PASSWORD.SAVE$ = PASSWORD$ THEN _
  1129.        PASSWORD.FAILED = 0 : _
  1130.        EXIT SUB
  1131. 667 ATTEMPTS = 0
  1132. 670 ATTEMPTS = ATTEMPTS + 1
  1133.     IF ATTEMPTS > ATTEMPTS.ALLOWED THEN _
  1134.        PASSWORD.FAILED = TRUE : _
  1135.        EXIT SUB
  1136. 675 A$ = "Enter Password (dots echo)"
  1137.     HIDDEN = TRUE
  1138.     SUBROUTINE.PARAMETER = 1
  1139.     CALL TGET
  1140.     IF SUBROUTINE.PARAMETER < 0 THEN _
  1141.        PASSWORD.FAILED = TRUE : _
  1142.        EXIT SUB
  1143.     HIDDEN = FALSE
  1144.     Z$ = B$
  1145. 677 IF LEN(Z$) > 15 THEN _
  1146.        GOTO 680
  1147.     IF EC <> 0 THEN _
  1148.        GOTO 670
  1149.     CALL ALLCAPS (Z$)
  1150.     Z$ = Z$ + SPACE$(15 - LEN(Z$))
  1151.     IF PASSWORD.SAVE$ = Z$ THEN _
  1152.        PASSWORD.FAILED = 0 : _
  1153.        A$ = "" : _
  1154.        EXIT SUB
  1155. 680 CALL QTPUT1 ("Wrong password ")
  1156.     IF NOT MESSAGE.PASSWORD THEN _
  1157.        CALL UPDTCALR (ACTIVE.USER.NAME$+" PW fail: " + Z$,1)
  1158.     GOTO 670
  1159.     END SUB
  1160. 945 ' $SUBTITLE: 'LINE25 - sub to build/display RBBS-PCs line 25'
  1161. ' $PAGE
  1162. '
  1163. '  NAME    -- LINE25
  1164. '
  1165. '  INPUTS  --     PARAMETER                    MEANING
  1166. '             SUBROUTINE.PARAMETER = 1  BUILD DISPLAY FOR LINE 25
  1167. '             SUBROUTINE.PARAMETER = 2  UPDATE LINE 25
  1168. '             LOCK.STATUS$              STATUS OF LOCKS IN A MULTI-
  1169. '                                       USER ENVIRONMENT OR TIME OF
  1170. '                                       DAY USER LOGGED ON OR THE
  1171. '                                       RE-CYCLED
  1172. '
  1173. '  OUTPUTS -- CURSOR.LINE               CURRENT LINE ON SCREEN
  1174. '             CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  1175. '
  1176. '  PURPOSE -- To build or update RBBS-PC's line 25 displayed
  1177. '             on the PC screen that is running RBBS-PC.
  1178. '
  1179.       SUB LINE25 STATIC
  1180.       IF SUBROUTINE.PARAMETER = 2 THEN _
  1181.          GOTO 950
  1182. '
  1183. '
  1184. ' *  BUILD LINE 25 DISPLAY
  1185. '
  1186. '
  1187. 949 LINE.25$ = "Node " + _
  1188.                NODE.ID$ + " " + _
  1189.                PAGE.STATUS$ + " " + _
  1190.                MID$("    AVL ",1 - 4 * SYSOP.AVAILABLE,4) + _
  1191.                MID$("    ANY ",1 - 4 * SYSOP.ANNOY,4) + _
  1192.                MID$("    LPT ",1 - 4 * PRINTER,4) + _
  1193.                MID$("SYS",1,-3 * SYSOP.NEXT) + _
  1194.                MID$(" XOFF",1,-5 * XOFF.ED) + _
  1195.                MID$(" CTS",1,-4 * NOT.CTS)
  1196. '
  1197. '
  1198. ' *  LINE 25 UPDATE ROUTINE
  1199. '
  1200. '
  1201. 950 IF NOT SNOOP THEN _
  1202.        EXIT SUB
  1203.     CURSOR.LINE = CSRLIN
  1204.     CURSOR.ROW = POS(0)
  1205.     HH = LEN(ACTIVE.USER.NAME$) + _
  1206.          LEN(CI$) + _
  1207.          LEN(LINE.25$) + _
  1208.          LEN(STR$(USER.SECURITY.LEVEL)) + _
  1209.          18
  1210.     IF AUTODOWNLOAD.AVAILABLE THEN _
  1211.        HH = HH + 4
  1212.     LOCATE 25,1
  1213.     IF NETWORK.TYPE = 0 THEN _
  1214.        IF AUTODOWNLOAD.AVAILABLE THEN _
  1215.           LOCK.STATUS$ = SPACE$(3) + _
  1216.                          "AD  " + _
  1217.                          TIME.LOGGED.ON$ _
  1218.        ELSE LOCK.STATUS$ = SPACE$(3) + _
  1219.                            TIME.LOGGED.ON$
  1220.     IF HH > 79 THEN _
  1221.        HH = 78
  1222.     LINE.25.HOLD$ = LINE.25$ + _
  1223.                     SPACE$(79 - HH) + _
  1224.                     STR$(USER.SECURITY.LEVEL) + _
  1225.                     " " + _
  1226.                     ACTIVE.USER.NAME$ + _
  1227.                     " " + _
  1228.                     CI$ + _
  1229.                     " " + _
  1230.                     LOCK.STATUS$
  1231.     CALL LPRNT(LINE.25.HOLD$,0)
  1232.     LOCATE CURSOR.LINE,CURSOR.ROW
  1233.     END SUB
  1234. 1238 ' $SUBTITLE: 'SRCHCMND    - sub to search command list'
  1235. ' $PAGE
  1236. '
  1237. '  NAME    -- SRCHCMND
  1238. '
  1239. '  INPUTS  -- PARAMETER             MEANING
  1240. '             STRT.POS      POSITION TO BEGIN SEARCH AT
  1241. '             ALL.OPTS$     STRING TO SEARCH (COMMAND LIST)
  1242. '             Z$            WHAT TO LOOK FOR
  1243. '
  1244. '  OUTPUTS -- WHERE.FOUND   POSITION OF Z$ IN ALL.OPTS$
  1245. '                           0 IF NOT FOUND
  1246. '
  1247. '  PURPOSE -- Searches valid command list for the requested
  1248. '             command.  If the sysop has configured RBBS-PC to
  1249. '             restrict commands to only those valid within the
  1250. '             RBBS-PC subsystem, then only those commands and
  1251. '             "GLOBAL" commands are valid.  Otherwise all commands
  1252. '             are valid from any of the RBBS-PC subsections.
  1253. '
  1254.      SUB SRCHCMND (STRT.POS,WHERE.FOUND) STATIC
  1255. 1240 IF LEN(Z$) < 1 THEN _
  1256.         WHERE.FOUND = 0 : _
  1257.         EXIT SUB
  1258.      CALL ALLCAPS (Z$)
  1259.      Y$ = LEFT$(Z$,1)
  1260.      WHERE.FOUND = INSTR(STRT.POS,ALL.OPTS$,Y$)
  1261.      IF WHERE.FOUND = 0 THEN _  'Not found: decide whether to hunt further
  1262.         IF STRT.POS < 2 OR RESTRICT.VALID.CMDS THEN _
  1263.            GOTO 1242 _  ' fully searched or restricted
  1264.         ELSE WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _ 'hunt further
  1265.              GOTO 1242
  1266.      IF WHERE.FOUND => BEG.LIBRARY THEN _
  1267.         IF WHERE.FOUND < LEN(ALL.OPTS$) - 11 THEN _
  1268.            IF LIBRARY.TYPE = 0 THEN _
  1269.               WHERE.FOUND = INSTR(WHERE.FOUND+1,ALL.OPT$,Y$) : _
  1270.               IF WHERE.FOUND = 0 THEN _
  1271.                  WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _
  1272.                  IF WHERE.FOUND >= BEG.LIBRARY OR WHERE.FOUND = 0 THEN _
  1273.                     WHERE.FOUND = 0 : _
  1274.                     GOTO 1242
  1275.      IF NOT RESTRICT.VALID.CMDS THEN _
  1276.         GOTO 1242            ' everything found valid
  1277. '
  1278. '
  1279. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)
  1280. '
  1281. '
  1282.      IF WHERE.FOUND > LEN(ALL.OPTS$) - 11 THEN _
  1283.         IF USER.SECURITY.LEVEL < OPT.SEC(WHERE.FOUND) THEN _
  1284.            WHERE.FOUND = 0 : _
  1285.            EXIT SUB _
  1286.         ELSE GOTO 1242                                               ' KG060701
  1287.      IF MID$(ORIG.COMMANDS$,WHERE.FOUND,1) = "G" THEN _
  1288.         GOTO 1242          ' ACCEPT GOODBYE/GRAPHICS                 ' KG060701
  1289.      IF (WHERE.FOUND < STRT.POS) OR _
  1290.         (STRT.POS < BEG.FILE AND WHERE.FOUND => BEG.FILE ) OR _
  1291.         (STRT.POS < BEG.UTIL AND WHERE.FOUND => BEG.UTIL ) OR _
  1292.         (STRT.POS < BEG.LIBRARY AND WHERE.FOUND => BEG.LIBRARY ) THEN _
  1293.            WHERE.FOUND = 0                 ' REJECT: NOT IN SECTION
  1294. 1242 IF WHERE.FOUND > 0 THEN _                                       ' KG060701
  1295.         LSET LAST.COMMAND$ = ACTIVE.MENU$ + MID$(ORIG.COMMANDS$,WHERE.FOUND) : _
  1296.         EXIT SUB                                                     ' KG060701
  1297.      IF MACRO.ACTIVE OR LEN(Z$) <> 1 THEN _                          ' KG060701
  1298.         EXIT SUB
  1299.      CALL ACHKMAC (Z$,FOUND)
  1300.      IF FOUND THEN _
  1301.         CALL FDMACEXE : _
  1302.         Z$ = B$(1) : _
  1303.         GOTO 1240
  1304.      END SUB
  1305. 1320 ' $SUBTITLE: 'CHKMACRO - sub to check if macro exists & process'
  1306. ' $PAGE
  1307. '
  1308. '  NAME    -- CHKMACRO
  1309. '
  1310. '  INPUTS  -- PARAMETER             MEANING
  1311. '             STRNG$           STRING TO CHECK IF IS A MACRO
  1312. '             MACRO.DRVPATH$   DRIVE/PATH WHERE MACROS ARE
  1313. '             MACRO.EXTENSION$ EXTENSION OF MACROS
  1314. '             MACRO.OFF        FORCE NO MACRO TO BE FOUND
  1315. '
  1316. '  OUTPUTS -- MACRO.FOUND      WHETHER A MACRO WAS FOUND
  1317. '             STRNG$           SUBSTITUTE FOR COMMANDS
  1318. '             COMMPORT.STACK$  REST OF MACRO
  1319. '                              0 IF NOT FOUND
  1320. '
  1321. '  PURPOSE -- Macro file is checked for security (1st line).
  1322. '             2nd line is substituted for passed string
  1323. '             and parsed.  Remaining part of macro put into
  1324. '             stack to be executed.
  1325. '
  1326.      SUB CHKMACRO (STRNG$,MACRO.FOUND) STATIC
  1327.      MACRO.FOUND = FALSE
  1328.      IF MACRO.EXTENSION$ = "" THEN _                                 ' KG060701
  1329.         EXIT SUB                                                     ' KG060701
  1330.      IF LEN(STRNG$) < MACRO.MIN THEN _
  1331.         MACRO.MIN = 1 : _
  1332.         EXIT SUB
  1333.      IF LEN(STRNG$) = 1 THEN _
  1334.         TEMP$ = STRNG$ : _
  1335.         CALL ALLCAPS (TEMP$) : _
  1336.         IF INSTR(ALL.OPTS$,TEMP$) > 0 THEN _
  1337.            EXIT SUB
  1338.      CALL ACHKMAC (STRNG$,MACRO.FOUND)
  1339.      END SUB
  1340. 1325 ' $SUBTITLE: 'ACHKMAC - check if macro exists & process'
  1341. ' $PAGE
  1342. '
  1343. '  NAME    -- ACHKMAC
  1344. '
  1345. '  INPUTS  -- PARAMETER             MEANING
  1346. '             STRNG$           STRING TO CHECK IF IS A MACRO
  1347. '             MACRO.DRVPATH$   DRIVE/PATH WHERE MACROS ARE
  1348. '             MACRO.EXTENSION$ EXTENSION OF MACROS
  1349. '             MACRO.OFF        FORCE NO MACRO TO BE FOUND
  1350. '
  1351. '  OUTPUTS -- MACRO.FOUND      WHETHER A MACRO WAS FOUND
  1352. '             STRNG$           SUBSTITUTE FOR COMMANDS
  1353. '             COMMPORT.STACK$  REST OF MACRO
  1354. '                              0 IF NOT FOUND
  1355. '
  1356. '  PURPOSE -- Executes a macro if found.  Does not check if macro
  1357. '             letter uses a command.
  1358.      SUB ACHKMAC (STRNG$,MACRO.FOUND) STATIC
  1359.      TEMP$ = STRNG$
  1360.      CALL BRKFNAME (TEMP$,DF$,PREFX$,X$,FALSE)
  1361.      IF TEMP$ = PREFX$ THEN _
  1362.         FILNAME$ = MACRO.DRVPATH$ + STRNG$ + MACRO.EXTENSION$ _
  1363.      ELSE FILNAME$ = STRNG$
  1364.      CALL BADFILE (FILNAME$,A)
  1365.      IF A > 1 THEN _
  1366.         EXIT SUB
  1367.      CALL GRAPHICX (USER.GRAPHIC.DEFAULT$,FILNAME$,6)                ' KG061001
  1368.      IF NOT OK THEN _
  1369.         EXIT SUB                                                     ' KG061001
  1370.      CALL READDIR (6,1)
  1371.      IF EC > 0 THEN _
  1372.         EXIT SUB
  1373.      CALL CHECKINT (A$)
  1374.      IF EC > 0 OR USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _
  1375.         EXIT SUB
  1376.      A = INSTR(A$,"/")                                               ' KG060701
  1377.      IF A > 0 THEN _    ' Check macro contraint                      ' KG060701
  1378.         X$ = RIGHT$(A$,LEN(A$)-A) : _                                ' KG060701
  1379.         IF LEFT$(LAST.COMMAND$,LEN(X$)) <> X$ THEN _                 ' KG060701
  1380.            EXIT SUB                                                  ' KG060701
  1381.      MACRO.ACTIVE = TRUE
  1382.      MACRO.FOUND = TRUE
  1383.      MACRO.ECHO = TRUE
  1384.      END SUB
  1385. 1330 ' $SUBTITLE: 'VIEWHELP    - Processes requests for help'
  1386. ' $PAGE
  1387. '
  1388. '  NAME    -- VIEWHELP
  1389. '
  1390. '  INPUTS  -- PARAMETER             MEANING
  1391. '            SECTION             ORDER OF 1ST COMMAND IN CURRENT
  1392. '                                   SECTION
  1393. '            GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1394. '            HELP.DEFAULT$       HELP GET IF PRESS ENTER
  1395. '            HELP.PATH$
  1396. '            HELP.EXTENSION$
  1397. '            BEG.FILE
  1398. '            BEG.MAIN
  1399. '            BEG.UTIL
  1400. '            BEG.LIBRARY
  1401. '
  1402. '  OUTPUTS -- DISPLAYS HELP
  1403. '
  1404. '  PURPOSE -- The main help processor for RBBS.  Puts up the
  1405. '             optional menu.  Accepts help with individual commands.
  1406. '
  1407.      SUB VIEWHELP (SECTION,GRAPHIC.DEFAULT$,HELP.DEFAULT$) STATIC
  1408.      HELP.MENU$ = HELP.PATH$ + _
  1409.                   "HELP" + _
  1410.                   HELP.EXTENSION$
  1411.      GOT.MENU = TRUE
  1412.      IF Q > 1 THEN _
  1413.         ANS.INDEX = 2 : _
  1414.         LAST.INDEX = Q: _
  1415.         FAST.HELP = TRUE : _
  1416.         GOTO 1332
  1417. 1331 IF GOT.MENU THEN _
  1418.         FILE.NAME$ = HELP.MENU$ : _
  1419.         GOSUB 1350 : _
  1420.         GOT.MENU = FALSE
  1421.      ANS.INDEX = 1
  1422.      A$ = "Help with what Command (or TOPIC name)" + _
  1423.           PRESS.ENTER.EXPERT$
  1424.      SUBROUTINE.PARAMETER = 1
  1425.      CALL TGET
  1426.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1427.         EXIT SUB
  1428.      IF Q = 0 THEN _
  1429.         EXIT SUB
  1430.      LAST.INDEX = Q
  1431. 1332 Z$ = B$(ANS.INDEX)
  1432.      CALL ALLCAPS (Z$)
  1433.      IF Z$ = "?" THEN _
  1434.         Z$ = "H"
  1435.      CALL BADFILE (Z$,BAD.FILE.NAME.INDEX)
  1436.      ON BAD.FILE.NAME.INDEX GOTO 1333,1340,1340
  1437. 1333 IF LEN(Z$) = 1 THEN _
  1438.         CALL SRCHCMND (SECTION,FF) : _
  1439.         IF FF < 1 THEN _
  1440.            OK = FALSE : _
  1441.            GOTO 1334 _
  1442.         ELSE X = - (FF => BEG.MAIN) - (FF => BEG.FILE) - (FF => BEG.UTIL) - (FF => BEG.LIBRARY) : _
  1443.              Z$ = MID$("MFU@",X,1) + _
  1444.                   MID$(ORIG.COMMANDS$,FF,1)
  1445.      FILE.NAME$ = HELP.PATH$ + _
  1446.                   Z$ + _
  1447.                   HELP.EXTENSION$
  1448.      GOSUB 1350
  1449. 1334 IF NOT OK THEN _
  1450.         A$ = "No help for " + _
  1451.              Z$ : _
  1452.         CALL QTPUT1 (A$) : _
  1453.         CALL UPDTCALR (A$,2)
  1454.      ANS.INDEX = ANS.INDEX + 1
  1455.      IF ANS.INDEX <= LAST.INDEX THEN _
  1456.         GOTO 1332
  1457.      IF FAST.HELP THEN _
  1458.         FAST.HELP = FALSE : _
  1459.         EXIT SUB
  1460.      GOTO 1331
  1461. 1340 OK = FALSE
  1462.      GOTO 1334
  1463. 1350 CALL GRAPHIC (GRAPHIC.DEFAULT$,FILE.NAME$)
  1464.      CALL BUFFILE (FILE.NAME$,X)
  1465.      RETURN
  1466.      END SUB
  1467. 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1468. ' $PAGE
  1469. '
  1470. '  NAME    -- SVIOLATION
  1471. '
  1472. '  INPUTS  --     PARAMETER                    MEANING
  1473. '
  1474. '  OUTPUTS -- CURSOR.LINE               CURRENT LINE ON SCREEN
  1475. '             CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  1476. '
  1477. '  PURPOSE -- Inform caller of security violation, augment count of
  1478. '             violations and determine whether too many occurred.
  1479. '
  1480.      SUB SVIOLATION STATIC
  1481.      CALL BUFFILE (SECVIO.HLP$,X)
  1482.      IF NOT OK THEN _
  1483.         CALL QTPUT1 ("Sorry, " + FIRST.NAME$ + ", action not permitted")
  1484.      CALL UPDTCALR ("SV!-" + VIOLATION$,2)
  1485.      CALL MUZAK (3)
  1486.      VIOLATIONS.THIS.SESSION = VIOLATIONS.THIS.SESSION + 1
  1487.      IF MAXIMUM.VIOLATIONS = 0 OR VIOLATIONS.THIS.SESSION <= MAXIMUM.VIOLATIONS THEN _
  1488.         EXIT SUB
  1489. 1385 IF USER.FILE.INDEX < 1 THEN _
  1490.         EXIT SUB
  1491.      A$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1492.      IF USER.SECURITY.LEVEL <= MINIMUM.LOGON.SECURITY THEN _
  1493.         A$ = "" : _
  1494.         USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - 1 _
  1495.      ELSE USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY
  1496.      DENY.ACCESS = TRUE
  1497.      END SUB
  1498. 1386 ' $SUBTITLE: 'DENYACCESS - sub to permanently deny access'
  1499. ' $PAGE
  1500. '
  1501. '  NAME    -- DENYACCESS
  1502. '
  1503. '  INPUTS  --     PARAMETER                    MEANING
  1504. '
  1505. '  OUTPUTS -- (USER'S RECORD)
  1506. '
  1507. '  PURPOSE -- Permanently resets user's security level when access denied
  1508. '
  1509.      SUB DENYACCESS STATIC
  1510.      CALL TPUT
  1511.      LOGON.ERROR.INDEX = 5
  1512.      SUBROUTINE.PARAMETER = 6
  1513.      CALL FILELOCK
  1514.      CALL OPENUSER (HIGHEST.USER.RECORD)
  1515.      FIELD 5, 128 AS USER.RECORD$
  1516.      GET 5,USER.FILE.INDEX
  1517.      MID$(USER.RECORD$,47,2) = MKI$(USER.SECURITY.LEVEL)
  1518.      PUT 5,USER.FILE.INDEX
  1519.      SUBROUTINE.PARAMETER = 8
  1520.      CALL FILELOCK
  1521.      END SUB
  1522. 1396 ' $SUBTITLE: 'TPUT -- common routine to write to comm. port'
  1523. ' $PAGE
  1524. '
  1525. '  NAME    -- TPUT (TERMINAL PUT)
  1526. '
  1527. '  INPUTS  --     PARAMETER                    MEANING
  1528. '                     A$                 STRING TO WRITE TO THE
  1529. '                                        COMMUNICATIONS PORT
  1530. '              SUBROUTINE.PARAMETER = 1  SKIP A LINE BEFORE WRITING
  1531. '                                        TO THE COMMUNICATIONS PORT
  1532. '                                   = 2  SKIP A LINE BEFORE WRITING
  1533. '                                        TO THE COMMUNICATIONS PORT
  1534. '                                        AND THEN SKIP TWO LINES
  1535. '                                        AFTER WRITING TO THE COMM-
  1536. '                                        UNICATIONS PORT
  1537. '                                   = 3  WRITE TO THE COMMUNICATIONS
  1538. '                                        PORT AND THEN SKIP TWO LINES
  1539. '                                   = 4  WRITE TO THE COMMUNICATIONS
  1540. '                                        PORT WITHOUT A CR/LF
  1541. '                                   = 5  WRITE TO THE COMMUNICATIONS
  1542. '                                        PORT WITH A CR/LF
  1543. '                                   = 6  RESET EVERYTHING FOR INPUT STRING
  1544. '                                   = 7  RE-ENTRY AFTER HANDLING A
  1545. '                                        FUNCTION KEY
  1546. '
  1547. '  OUTPUTS --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  1548. '              FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  1549. '
  1550. '  PURPOSE --  Common output routine for RBBS-PC to the
  1551. '              communications port (terminal put)
  1552.       SUB TPUT STATIC
  1553.       IF SUBROUTINE.PARAMETER <> 7 THEN _
  1554.          PARM = SUBROUTINE.PARAMETER
  1555.       ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411
  1556. '
  1557. '
  1558. ' *  COMMON OUTPUT ROUTINE
  1559. '
  1560. '
  1561. 1398 CALL SKIPLINE (1)
  1562.      GOTO 1405
  1563. 1399 CALL SKIPLINE (1)
  1564. 1400 CR = 1
  1565. 1403 CR = CR + 1
  1566. 1405 RET = FALSE
  1567.      IF CM THEN _
  1568.         GOTO 1435
  1569. 1410 CALL FINDFUNC
  1570.      IF SUBROUTINE.PARAMETER < 0 THEN _
  1571.         EXIT SUB
  1572. 1411 Y$ = KEY.PRESSED$
  1573.      SUBROUTINE.PARAMETER = PARM
  1574.      IF LOCAL.USER THEN _
  1575.         GOTO 1430
  1576.      CALL EOFCOMM (CHAR%)
  1577.      IF CHAR% = -1 THEN _
  1578.         CALL CHKCARRIER : _                                          ' KG061203
  1579.         IF SUBROUTINE.PARAMETER = -1 THEN _
  1580.            EXIT SUB _
  1581.         ELSE GOTO 1430
  1582.      CALL GETCOM(Y$)
  1583. 1425 IF SUBROUTINE.PARAMETER = -1 THEN _
  1584.         EXIT SUB
  1585. 1430 IF Y$ = "" THEN _
  1586.         GOTO 1435
  1587.      ON INSTR(INTERRUPT.ON$,Y$) GOTO 1434,1434,1473,1475,1433
  1588.      GOSUB 1476
  1589.      GOTO 1435
  1590. 1433 GOSUB 1476
  1591.      IF ASC(RIGHT$(COMMPORT.STACK$,2)) = 13 OR _
  1592.         STOP.INTERRUPTS THEN _
  1593.         GOTO 1435  'stack if series of [ENTER]s or no previous stack
  1594.      GOTO 1471
  1595. 1434 IF STOP.INTERRUPTS THEN _
  1596.         GOTO 1435
  1597.      COMMPORT.STACK$ = ""
  1598.      IF FOSSIL THEN _
  1599.         CALL FOSTXPURGE(COMPORT%) : _
  1600.         CALL FOSRXPURGE(COMPORT%)
  1601.      GOTO 1471
  1602. 1435 LOCATE ,,1
  1603.      CALL LPRNT (A$,0)
  1604. 1437 IF UPPER.CASE THEN _
  1605.         IF GR <> 2 THEN _
  1606.            CALL ALLCAPS (A$)
  1607.      CALL PUTCOM (A$)
  1608. 1450 IF CR <> 1 THEN _
  1609.         CALL SKIPLINE (1) _
  1610.      ELSE IF CR > 1 THEN _
  1611.              CALL SKIPLINE (1)
  1612. 1470 CR = 0
  1613.      TOA! = FRE("A")
  1614.      EXIT SUB
  1615. 1471 CALL SKIPLINE (1)
  1616.      STOP.INTERRUPTS = FALSE
  1617.      RET = TRUE
  1618.      NO = TRUE                                                       ' KG060401
  1619.      NON.STOP = FALSE
  1620.      GOTO 1470
  1621. 1473 XOFF.ED = TRUE
  1622.      GOTO 1410
  1623. 1475 XOFF.ED = FALSE
  1624.      GOTO 1410
  1625. 1476 IF ASC(Y$) < 127 THEN _
  1626.         COMMPORT.STACK$ = COMMPORT.STACK$ + Y$
  1627.      RETURN
  1628.      END SUB
  1629. 1478 ' $SUBTITLE: 'QTPUT - subroutine to quickly write to terminal'
  1630. ' $PAGE
  1631. '
  1632. '  NAME    -- QTPUT
  1633. '
  1634. '  INPUTS  -- PARAMETER             MEANING
  1635. '             STRNG$        STRING TO WRITE OUT
  1636. '             NUM.RETURNS   NUMBER OF CARRIAGE RETURNS
  1637. '
  1638. '  OUTPUTS -- NONE
  1639. '
  1640. '  PURPOSE -- Subroutine to quickly write to the terminal.  This is
  1641. '             different from "TPUT" in the things it doesn't do:
  1642. '                A.) NO function key check,
  1643. '                B.) NO conversion to upper case,
  1644. '                C.) NO check for carrier present
  1645. '                D.) NO check for imbedded carriage return in "STRNG$"
  1646. '                E.) NO support for XON/XOFF
  1647. '
  1648.       SUB QTPUT (STRNG$,NUM.RETURNS) STATIC
  1649.       IF USE.TPUT THEN _
  1650.          A$ = STRNG$ : _
  1651.          SUBROUTINE.PARAMETER = 4 : _
  1652.          CALL TPUT : _
  1653.          CALL SKIPLINE (NUM.RETURNS) : _
  1654.          EXIT SUB
  1655.       CALL PUTCOM (STRNG$)
  1656.       LOCATE ,,1
  1657.       CALL LPRNT (STRNG$,0)
  1658.       CALL SKIPLINE (NUM.RETURNS)
  1659.       END SUB
  1660.       SUB QTPUT1 (STRNG$) STATIC
  1661.       CALL QTPUT (STRNG$,1)
  1662.       END SUB
  1663. 1480 ' $SUBTITLE: 'LPRNT    - subroutine to write to display'
  1664. ' $PAGE
  1665. '
  1666. '  NAME    -- LPRNT
  1667. '
  1668. '  INPUTS  -- PARAMETER             MEANING
  1669. '             STRNG$        STRING TO WRITE OUT
  1670. '             NUM.RETURNS   NUMBER OF CARRIAGE RETURNS
  1671. '
  1672. '  OUTPUTS -- NONE
  1673. '
  1674. '  PURPOSE -- Subroutine to write to the display.
  1675. '
  1676.       SUB LPRNT (STRNG$,NUM.RETURNS) STATIC
  1677.       IF NOT SNOOP THEN _
  1678.          EXIT SUB
  1679.       CALL PSCRN (STRNG$)
  1680.       IF VOICE.TYPE <> 0 AND TALK.ALL THEN _
  1681.          CALL TALK (65,STRNG$)
  1682.       IF USE.BASIC.WRITES THEN _
  1683.          FOR I = 1 TO NUM.RETURNS : _
  1684.             PRINT : _
  1685.          NEXT : _
  1686.       ELSE FOR I = 1 TO NUM.RETURNS : _
  1687.               LOCATE ,,1 : _
  1688.               CALL ANSI(CRLF$,C.L,C.C) : _
  1689.               LOCATE C.L,C.C : _
  1690.               NEXT
  1691.       END SUB
  1692. 1482 ' $SUBTITLE: 'QLPRNT - subroutine to quickly write to display'
  1693. ' $PAGE
  1694. '
  1695. '  NAME    -- QLPRNT
  1696. '
  1697. '  INPUTS  -- PARAMETER             MEANING
  1698. '             STRNG$        STRING TO WRITE OUT
  1699. '             NUM           NUMBER OF CARRIAGE RETURNS
  1700. '
  1701. '  OUTPUTS -- NONE
  1702. '
  1703. '  PURPOSE -- Subroutine to quickly write to the display.
  1704. '             Overwrites, and puts up count
  1705.       SUB QLPRNT (STRNG$,NUM) STATIC
  1706.       LOCATE ,1,1
  1707.       CALL LPRNT (STRNG$ + STR$(NUM),0)
  1708.       END SUB
  1709. 1483 ' $SUBTITLE: 'PSCRN    - subroutine to print to the screen'
  1710. ' $PAGE
  1711. '
  1712. '  NAME    -- PSCRN
  1713. '
  1714. '  INPUTS  -- PARAMETER             MEANING
  1715. '             STRNG$        STRING TO WRITE OUT
  1716. '
  1717. '  OUTPUTS -- NONE
  1718. '
  1719. '  PURPOSE -- Writes to local screen regardless of whether you have
  1720. '             carrier.  Assumes have positioned cursor where you want.
  1721. '
  1722.       SUB PSCRN (STRNG$) STATIC
  1723.       IF STRNG$ = "" THEN _
  1724.          EXIT SUB
  1725.       IF USE.BASIC.WRITES THEN _
  1726.          PRINT STRNG$; _
  1727.       ELSE CALL ANSI (STRNG$,C.L,C.C) : _
  1728.            LOCATE C.L,C.C
  1729.       END SUB
  1730. 1485 ' $SUBTITLE: 'SKIPLINE - sub to write a blank line to user'
  1731. ' $PAGE
  1732. '
  1733. '  NAME    -- SKIPLINE
  1734. '
  1735. '  INPUTS  --   PARAMETER             MEANING
  1736. '               LOCAL.USER
  1737. '               MODEM.STATUS.REGISTER
  1738. '               NUM.RETURNS
  1739. '               RETURN.LINE.FEED$
  1740. '               SNOOP
  1741. '
  1742. '  OUTPUTS -- NONE
  1743. '
  1744. '  PURPOSE -- Skip lines on the user's terminal
  1745. '
  1746.       SUB SKIPLINE (NUM.RETURNS) STATIC
  1747.       FOR I=1 TO NUM.RETURNS
  1748.           CALL PUTCOM (RETURN.LINE.FEED$)
  1749.       NEXT
  1750.       IF NOT SNOOP THEN _
  1751.          GOTO 1486
  1752.       IF USE.BASIC.WRITES THEN _
  1753.          FOR I = 1 TO NUM.RETURNS : _
  1754.             PRINT : _
  1755.          NEXT : _
  1756.       ELSE FOR I = 1 TO NUM.RETURNS : _
  1757.               LOCATE ,,1 : _
  1758.               CALL ANSI(CRLF$,C.L,C.C) : _
  1759.               LOCATE C.L,C.C : _
  1760.               NEXT
  1761. 1486  LINES.PRINTED = LINES.PRINTED + NUM.RETURNS
  1762.       UNIT.COUNT = UNIT.COUNT - DISPLAY.AS.UNIT * NUM.RETURNS
  1763.       END SUB
  1764. 1496 ' $SUBTITLE: 'SETCRLF -- sub to set up nulls/lf's for output'
  1765. ' $PAGE
  1766. '
  1767. '  NAME    -- SETCRLF
  1768. '
  1769. '  INPUTS  --   PARAMETER          MEANING
  1770. '              CARRIAGE.RETURN$    CARRIAGE RETURN CHARACTER
  1771. '              LINE.FEED$          LINE FEED CHARACTER
  1772. '              LINE.FEEDS          LINE FEED SWITCH
  1773. '              NUL$                NULL CHARACTER
  1774. '
  1775. '  OUTPUTS -- RETURN.LINE.FEED$   END-OF-LINE STRING
  1776. '
  1777. '  PURPOSE -- Set up the necessary nulls/line feeds to end
  1778. '             each output to the communications port with.
  1779. '
  1780.       SUB SETCRLF STATIC
  1781.       RETURN.LINE.FEED$ = _
  1782.          MID$(CARRIAGE.RETURN$,1, - (NOT LOCAL.USER)) + _
  1783.          NUL$ + _
  1784.          MID$(LINE.FEED$,1, - (LINE.FEEDS <> 0))
  1785.       END SUB
  1786. 1498 ' $SUBTITLE: 'TGET -- ask a user a question and get reply'
  1787. ' $PAGE
  1788. '
  1789. '  NAME    -- TGET
  1790. '
  1791. '  INPUTS  --    PARAMETER                   MEANING
  1792. '             SUBROUTINE.PARAMETER = 1  STANDARD ENTRY
  1793. '             SUBROUTINE.PARAMETER = 2  ENTRY AFTER A FUNCTION KEY
  1794. '                                       HAS BEEN HANDLED
  1795. '                    A$                 STRING TO WRITE TO THE
  1796. '                                       COMMUNICATIONS PORT
  1797. '             HIDDEN                    IF THIS IS TRUE THEN ECHO
  1798. '                                       '.' INSTEAD OF ACTUAL
  1799. '                                       CHARACTER ENTERED.
  1800. '             FORCE.KEYBOARD            IF TRUE, STACKED INPUT
  1801. '                                       IS BYPASSED AND KEYBOARD
  1802. '                                       INPUT IS READ.
  1803. '
  1804. '  OUTPUTS -- SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  1805. '             B$                        STRING THAT WAS ENTERED
  1806. '             Q                         NUMBER OF PARAMETERES THAT
  1807. '                                       WERE ENTERED WHICH WHERE
  1808. '                                       SEPARATED BY A SEMICOLON
  1809. '             B$()                      STRING MATRIX WITH EACH
  1810. '                                       ITEM CONTAIN THE STRING
  1811. '                                       THAT WAS ENTERED BETWEEN
  1812. '                                       SEMICOLONS.
  1813. '             FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  1814. '             YES                       REPLY IS "Y" OR "YES"
  1815. '             NO                        REPLY IS "N" OR "NO"
  1816. '             NON.STOP                  REPLY IS "NS" OR "ns"
  1817. '             KILL.MESSAGE              REPLY IS "K"
  1818. '             REPLY                     REPLY IS "RE"
  1819. '
  1820. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1821. '
  1822.       SUB TGET STATIC
  1823.       ON SUBROUTINE.PARAMETER GOTO 1500,1538
  1824. '
  1825. '
  1826. ' *  COMMON INPUT ROUTINE
  1827. '
  1828. '
  1829. 1500 CALL CARRIER
  1830.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1831.         EXIT SUB                                                     ' KG061203
  1832.      LINES.PRINTED = 0
  1833.      DISPLAY.AS.UNIT = FALSE
  1834.      IN.STACK = FALSE
  1835.      TOA! = FRE("A")
  1836.      GOSUB 1580                                                      ' KG071906
  1837.      A = 0
  1838.      B = 0
  1839.      C = 0
  1840.      Q = 1
  1841.      PARM = 0
  1842.      YES = FALSE
  1843.      B$ = ""
  1844.      SLEEP.WARN = TRUE
  1845.      NO = FALSE
  1846.      NON.STOP = (PAGE.LENGTH < 1)                                    ' KG072603
  1847.      IF A$ = "" THEN _
  1848.         GOTO 1525
  1849.      CALL COLORPMT (A$)
  1850.      A$ = A$ + _
  1851.           MID$("? !  ",2*TURBO.KEY+1,2)
  1852.      SUBROUTINE.PARAMETER = 4
  1853.      STOP.SAVE = STOP.INTERRUPTS
  1854.      STOP.INTERRUPTS = TRUE
  1855.      CALL TPUT
  1856.      STOP.INTERRUPTS = STOP.SAVE
  1857.      IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1858.         EXIT SUB
  1859. 1523 IF PROMPT.BELL THEN _
  1860.         IF LOCAL.USER THEN _
  1861.            BEEP_
  1862.         ELSE CALL PUTCOM(BELL.RINGER$)
  1863. 1525 CALL CARRIER
  1864.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1865.         EXIT SUB
  1866.      IF LEN(COMMPORT.STACK$) > 0 THEN _                              ' KG072602
  1867.         IN.STACK = TRUE : _
  1868.         X = INSTR(COMMPORT.STACK$,CARRIAGE.RETURN$) : _
  1869.         IF X > 0 THEN _
  1870.            A$ = LEFT$(COMMPORT.STACK$,X-1) : _
  1871.            COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-X) : _
  1872.            GOTO 1534 _
  1873.         ELSE Y$ = LEFT$(COMMPORT.STACK$,1) : _
  1874.              COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  1875.              GOTO 1541
  1876.      IF (FORCE.KEYBOARD OR (NOT MACRO.ACTIVE) OR (MACRO.SAVE > 0)) THEN _
  1877.         GOTO 1536
  1878. '
  1879. ' *** MACRO PROCESSING
  1880. '
  1881. 1526 CALL READMACRO
  1882.      IF (DISTANT.TGET > 0 ) OR (MACRO.TEMPLATE$ <> "") OR (MACRO.SAVE > 0) OR (NOT MACRO.ACTIVE) THEN _
  1883.         GOTO 1536
  1884. 1534 B$ = A$   ' Not Macro command - pass to normal processing
  1885.      IF MACRO.ECHO THEN _
  1886.         SUBROUTINE.PARAMETER = 4 : _
  1887.         CALL TPUT
  1888.      Y$ = CARRIAGE.RETURN$
  1889.      GOTO 1547
  1890. 1536 IF LOCAL.USER THEN _
  1891.         CALL FINDFUNC: _
  1892.         IF SUBROUTINE.PARAMETER < 0 THEN _
  1893.            EXIT SUB _
  1894.         ELSE GOTO 1538
  1895.      CALL EOFCOMM (CHAR%)
  1896.      IF CHAR% <> -1 THEN _
  1897.         CALL GETCOM(Y$) : _
  1898.         IF SUBROUTINE.PARAMETER = -1 THEN _
  1899.            EXIT SUB _
  1900.         ELSE GOTO 1541
  1901.      CALL FINDTIME (TI!)
  1902.      IF TI! > AUTO.WARN! THEN _
  1903.         IF TI! > AUTO.LOGOFF! THEN _
  1904.            CALL UPDTCALR ("Sleep disconnect",1) : _
  1905.            SUBROUTINE.PARAMETER = -1 : _
  1906.            EXIT SUB _
  1907.         ELSE IF SLEEP.WARN THEN _
  1908.                 SLEEP.WARN = FALSE : _
  1909.                 A$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _
  1910.                 CALL RINGCALLER
  1911.      CALL FINDFUNC
  1912.      IF SUBROUTINE.PARAMETER < 0 THEN _
  1913.         EXIT SUB
  1914. 1538 Y$ = KEY.PRESSED$
  1915.      IF Y$ <> "" THEN _
  1916.         GOTO 1545
  1917.      SEND.REMOTE = TRUE
  1918.      CALL GOIDLE
  1919.      GOTO 1525
  1920. 1541 SEND.REMOTE = REMOTE.ECHO
  1921.      IF TEST.PARITY THEN _
  1922.         GOTO 1542
  1923.      IF Y$ = CHR$(127) THEN _
  1924.         GOTO 1635
  1925.      GOTO 1545
  1926. 1542 IF Y$ = "" THEN _
  1927.         Y$ = " "
  1928.      IF ASC(Y$) = 141 THEN _
  1929.         OUT LINE.CONTROL.REGISTER,&H1A : _
  1930.         EIGHT.BIT = FALSE : _
  1931.         TEST.PARITY = FALSE : _
  1932.         GR = FALSE
  1933.      Y$ = CHR$(ASC(Y$) AND 127)
  1934. 1545 X$ = Y$
  1935.      IF INSTR(LINEEDIT.CHK$,Y$) > 5 _
  1936.         GOTO 1635
  1937.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  1938.         GOTO 1525
  1939.      IF Y$ = "^" THEN _
  1940.         GOTO 1525
  1941.      IF Y$ = CARRIAGE.RETURN$ THEN _
  1942.         GOTO 1547 _
  1943.      ELSE GOSUB 1550
  1944.      IF TURBO.KEY < 1 THEN _
  1945.         GOTO 1546
  1946.      IF Y$ = " " THEN _
  1947.         Y$ = ""
  1948.      IF Y$ <> "/" THEN _
  1949.         B$ = Y$ : _
  1950.         Y$ = CARRIAGE.RETURN$ : _
  1951.         X$ = Y$ : _
  1952.         GOTO 1547
  1953.      TURBO.KEY = 0
  1954.      GOTO 1525
  1955. 1546 IF LEN(B$) => 512 THEN _
  1956.         A$ = "Input too long!" : _
  1957.         SUBROUTINE.PARAMETER = 5 : _
  1958.         CALL TPUT : _
  1959.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1960.            EXIT SUB _
  1961.         ELSE GOTO 1500
  1962.      B$ = B$ + _
  1963.           Y$
  1964.      GOTO 1525
  1965. 1547 TURBO.KEY = FALSE          ' Carriage Return Handler
  1966.      HIDDEN = FALSE
  1967.      IF NO.ADVANCE THEN _
  1968.         NO.ADVANCE = FALSE : _
  1969.         GOTO 1575 _
  1970.      ELSE CALL LPRNT (CRLF$,0) : _
  1971.           GOSUB 1551 : _
  1972.           GOTO 1570
  1973. 1550 IF LOGON.ACTIVE THEN _
  1974.         IF (Y$ = " " OR Y$ = ";") AND _
  1975.            RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _
  1976.               PARM = PARM + 1 : _
  1977.               LOGON.ACTIVE = (PARM < 3) : _
  1978.               HIDDEN = (PARM = 2) : _
  1979.               CALL LPRNT(X$,0) : _
  1980.               GOTO 1551
  1981.      IF HIDDEN THEN _
  1982.         X$ = "."
  1983.      CALL LPRNT(X$,0)
  1984. 1551 IF NOT SEND.REMOTE THEN _
  1985.         RETURN
  1986.      IF HIDDEN THEN _
  1987.         X$ = "."
  1988. 1553 CALL PUTCOM (X$)
  1989.      RETURN
  1990. 1570 IF SEND.REMOTE THEN _
  1991.         IF LINE.FEEDS THEN _
  1992.            CALL PUTCOM (LINE.FEED$)
  1993. 1575 IF LEN(B$) > 4000 THEN _
  1994.         A$ = "Try again, " + _
  1995.              FIRST.NAME$ : _
  1996.         SUBROUTINE.PARAMETER = 5 : _
  1997.         CALL TPUT : _
  1998.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1999.            EXIT SUB _
  2000.         ELSE GOTO 1500
  2001.      IF PARSE.OFF THEN _
  2002.         PARSE.OFF = FALSE : _
  2003.         GOTO 1620
  2004.      CALL PARSEIT
  2005.      IF Q = 1 THEN _
  2006.         GOTO 1622
  2007.      GOTO 1625
  2008. 1580 CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT)            ' KG071905
  2009.      AUTO.WARN! = AUTO.LOGOFF! - 30                                  ' KG071905
  2010.      RETURN                                                          ' KG071905
  2011. 1620 B$(1) = B$
  2012.      Q = 1
  2013. 1622 IF B$ = "" THEN _
  2014.         Q = 0 : _
  2015.         HIDDEN = FALSE : _
  2016.         GOTO 1628
  2017. 1625 IF LEN(B$) < 4 THEN _
  2018.         X$ = LEFT$(B$,3): _
  2019.         CALL ALLCAPS (X$) : _
  2020.         IF X$ = "Y" OR X$ = "YES" THEN _
  2021.            YES = TRUE _
  2022.         ELSE IF X$ = "N" OR X$ = "NO" OR X$ = "A" THEN _
  2023.                 NO = TRUE _
  2024.              ELSE IF X$ = "RE" THEN _
  2025.                      REPLY = TRUE : _
  2026.                      GOTO 1628 _
  2027.                   ELSE IF X$ = "K" THEN _
  2028.                           KILL.MESSAGE = TRUE : _
  2029.                           GOTO 1628
  2030.      FORCE.KEYBOARD = FALSE
  2031.      HIDDEN = FALSE
  2032. 1628 IF MACRO.SAVE > 0 THEN _
  2033.         GSR.ARA$(MACRO.SAVE) = B$ : _
  2034.         MACRO.SAVE = 0 : _
  2035.         GOTO 1632                                                    ' KG071905
  2036.      IF (DISTANT.TGET > 0) OR (MACRO.TEMPLATE$ <> "") THEN _
  2037.         CALL WIPELINE (38) : _
  2038.         IF NOT NO THEN _
  2039.            GOTO 1632 _                                               ' KG071905
  2040.         ELSE Q = 0 : _
  2041.              MACRO.TEMPLATE$ = "" : _
  2042.              DISTANT.TGET = 0 : _
  2043.              NO = FALSE : _                                          ' KG061001
  2044.              GOTO 1633                                               ' KG071905
  2045.      IF MACRO.ACTIVE OR ((NOT IN.STACK) AND INSTR(B$,".") > 0) THEN _ ' KG060189
  2046.         EXIT SUB
  2047.      CALL NOPATH (B$(1),FOUND)                                       ' KG060801
  2048.      IF FOUND THEN _                                                 ' KG060801
  2049.         EXIT SUB                                                     ' KG060801
  2050.      CALL CHKMACRO (B$(1),FOUND)                                     ' KG060189
  2051.      IF FOUND THEN _
  2052.         GOTO 1525
  2053.      EXIT SUB
  2054. 1632 B$ = ""                                                         ' KG071905
  2055.      FORCE.KEYBOARD = FALSE                                          ' KG071905
  2056. 1633 GOSUB 1580                                                      ' KG071906
  2057.      Q = 1                                                           ' KG072601
  2058.      GOTO 1525                                                       ' KG071905
  2059. 1635 IF LEN(B$) = 0 THEN _
  2060.         GOTO 1525
  2061.      IF LOGON.ACTIVE THEN _
  2062.         IF INSTR(" ;",RIGHT$(B$,1)) > 0 THEN _
  2063.            PARM = PARM - 1
  2064.      B$ = LEFT$(B$,LEN(B$)-1)
  2065.      CALL LPRNT(LOCAL.BACKSPACE$,0)
  2066.      IF SEND.REMOTE THEN _
  2067.         CALL PUTCOM(BACKSPACE$)
  2068.      GOTO 1525
  2069.      END SUB
  2070. 1636 ' $SUBTITLE: 'RINGCALLER - sub to use sound + screen emphasis'
  2071. ' $PAGE
  2072. '
  2073. '  NAME    -- RINGCALLER
  2074. '
  2075. '  INPUTS  --     PARAMETER                    MEANING
  2076. '                 A$                           STRING TO EMPHASIZE
  2077. '
  2078. '  OUTPUTS --  none
  2079. '
  2080. '  PURPOSE --  Rings the users bell before and after string
  2081. '              (but not snooping sysop) and adds emphasis around
  2082. '              message sent.
  2083. '
  2084.      SUB RINGCALLER STATIC
  2085.      X$ = LEFT$(BELL.RINGER$,-LOCAL.USER)
  2086.      CALL PUTCOM (BELL.RINGER$)
  2087.      CALL LPRNT (X$,0)
  2088.      SUBROUTINE.PARAMETER = 2
  2089.      A$ = EMPHASIZE.ON$ + A$ + EMPHASIZE.OFF$
  2090.      CALL TPUT
  2091.      CALL PUTCOM (BELL.RINGER$)
  2092.      CALL LPRNT (X$,0)
  2093.      END SUB
  2094. 1637 ' $SUBTITLE: 'PARSEIT - subroutine to parse a string'
  2095. ' $PAGE
  2096. '
  2097. '  NAME    -- PARSEIT
  2098. '
  2099. '  INPUTS  --     PARAMETER                    MEANING
  2100. '                 B$                           STRING TO PARSE
  2101. '
  2102. '  OUTPUTS --  Q                            NUMBER PARSED
  2103. '              B$()                         PARSED STRINGS
  2104. '
  2105. '  PURPOSE --  To parse a string into pieces.  Uses semicolon
  2106. '              if exists, otherwise space
  2107. '
  2108.      SUB PARSEIT STATIC
  2109.      A = INSTR(B$,";")
  2110.      IF A > 0 THEN _
  2111.         PARSE.CHAR$ = ";" _
  2112.      ELSE IF B$ <> SPACE$(LEN(B$)) THEN _
  2113.              CALL TRIM (B$) : _
  2114.              X$ = B$ : _                                             ' KG060302
  2115.              A = INSTR(B$,"  ") : _
  2116.              WHILE A > 0 : _
  2117.                 B$ = LEFT$(B$,A - 1) + _
  2118.                      MID$(B$,A + 1) : _
  2119.                 A = INSTR(A,B$,"  ") : _
  2120.              WEND : _
  2121.              A = INSTR(B$," ") : _
  2122.              IF A > 1 THEN _
  2123.                 PARSE.CHAR$ = " " _
  2124.              ELSE A = INSTR(B$,",") : _
  2125.                   PARSE.CHAR$ = ","
  2126.      IF A < 2 THEN _
  2127.         B$(1) = B$ : _
  2128.         DF$ = B$ : _                                                 ' KG071903
  2129.         CALL ALLCAPS (DF$) : _                                       ' KG071903
  2130.         NON.STOP = NON.STOP OR (DF$ = "C") : _                       ' KG071903
  2131.         EXIT SUB
  2132.      B$(1) = LEFT$(B$,A - 1)
  2133.      A = A + 1
  2134.      EOL = FALSE
  2135. 1640 B = INSTR(A,B$,PARSE.CHAR$)
  2136.      C = B-A
  2137.      IF C < 1 THEN _
  2138.         EOL = TRUE : _
  2139.         C = 128
  2140.      DF$ = MID$(B$,A,C)
  2141.      IF DF$ <> "" THEN _
  2142.         Q = Q + 1 : _
  2143.         B$(Q) = DF$ : _
  2144.         CALL ALLCAPS(DF$) : _
  2145.         X = INSTR("NS;/G;C;",DF$+";") : _                            ' KG072402
  2146.         IF X > 0 THEN _
  2147.            IF LEN(DF$) = 2 THEN _
  2148.               Q = Q - 1 : _
  2149.               NON.STOP = NON.STOP OR (X = 1) : _
  2150.               AUTO.LOGOFF = AUTO.LOGOFF OR (X = 4) _
  2151.            ELSE IF LEN(DF$) = 1 THEN _                               ' KG071903
  2152.                    NON.STOP = NON.STOP OR (X = 7)                    ' KG071903
  2153.      IF NOT EOL AND Q < 50 THEN _
  2154.         A = B + 1 : _
  2155.         GOTO 1640
  2156.      IF PARSE.CHAR$ <> ";" THEN _                                    ' KG060302
  2157.         B$ = X$                                                      ' KG060302
  2158.      END SUB
  2159. 1654 ' $SUBTITLE: 'SETBAUD - sub to set the baud rate in the RS232'
  2160. ' $PAGE
  2161. '
  2162. '  NAME    -- SETBAUD
  2163. '
  2164. '  INPUTS  --     PARAMETER                    MEANING
  2165. '             BAUD.RATE.DIVISOR   NUMBER TO DIVIDE THE 8250 CHIP'S
  2166. '                                 PROGRAMABLE CLOCK TO ADJUST THE
  2167. '                                 BAUD RATE TO THE USER'S BAUD
  2168. '                                 RATE (INDEPENDENT OF THE BAUD
  2169. '                                 RATE USED TO OPEN THE COMM. PORT)
  2170. '
  2171. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2172. '            RATE              PCjr         PC AND XT
  2173. '              50             2237             2304
  2174. '              75             1491             1536
  2175. '             110             1017             1047
  2176. '             134.5            832              857
  2177. '             150              746              768
  2178. '             300              373              384
  2179. '             600              186              192
  2180. '            1200               93               96
  2181. '            1800               62               64
  2182. '            2000               56               58
  2183. '            2400               47               48
  2184. '            3600               31               32
  2185. '            4800               23               24
  2186. '            7200          not available         16
  2187. '            9600          not available         12
  2188. '           19200          not available          6
  2189. '  OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
  2190. '
  2191. '  PURPOSE -- To set the baud rate in the RS232 interface
  2192. '             inpependent of the baud rate the communications port
  2193. '             was opened at
  2194. '
  2195.       SUB SETBAUD STATIC
  2196.      IF NOT KEEP.INIT.BAUD THEN _
  2197.         TALK.TO.MODEM.AT$ =  MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5) _
  2198.      ELSE TALK.TO.MODEM.AT$ = MODEM.INIT.BAUD$
  2199.      CALL TRIM (TALK.TO.MODEM.AT$)
  2200.      IF LEN(TALK.TO.MODEM.AT$) < 5 THEN _
  2201.         TALK.TO.MODEM.AT$ = SPACE$(4 - LEN(TALK.TO.MODEM.AT$)) + _
  2202.                             TALK.TO.MODEM.AT$
  2203.      IF EIGHT.BIT THEN_
  2204.         PARITY% = 2 : _                                    ' NO PARITY
  2205.         DATABITS% = 3 : _                                  ' 8 DATA BITS
  2206.         STOPBITS% = 0 _                                    ' 1 STOP BIT
  2207.      ELSE PARITY% = 3 : _                                  ' EVEN PARITY
  2208.           DATABITS% = 2 : _                                ' 7 DATA BITS
  2209.           STOPBITS% = 0                                    ' 1 STOP BIT
  2210.      COMSPEED% = VAL(TALK.TO.MODEM.AT$)
  2211.      IF FOSSIL THEN _
  2212.         CALL FOSSPEED(COMPORT%,COMSPEED%,PARITY%,DATABITS%,STOPBITS%) : _
  2213.         EXIT SUB
  2214.      IF COMSPEED% = 300 THEN _
  2215.         BAUD.RATE.DIVISOR = &H180 + (11 * (COMPUTER.TYPE = 2))
  2216.      IF COMSPEED% = 450 THEN _
  2217.         BAUD.RATE.DIVISOR = &H100 + (8 * (COMPUTER.TYPE = 2))
  2218.      IF COMSPEED% = 1200 THEN _
  2219.         BAUD.RATE.DIVISOR = &H60 + (3 * (COMPUTER.TYPE = 2))
  2220.      IF COMSPEED% = 2400 THEN _
  2221.         BAUD.RATE.DIVISOR = &H30 + (1 * (COMPUTER.TYPE = 2))
  2222.      IF COMSPEED% = 4800 THEN _
  2223.         BAUD.RATE.DIVISOR = &H18
  2224.      IF COMSPEED% = 9600 THEN _
  2225.         BAUD.RATE.DIVISOR = &HC
  2226.      IF COMSPEED% = 19200 THEN _
  2227.         BAUD.RATE.DIVISOR = &H6
  2228.      MOST.SIGNIFICANT.BYTE = FIX (BAUD.RATE.DIVISOR / 256)
  2229.      LEAST.SIGNIFICANT.BYTE = BAUD.RATE.DIVISOR - (MOST.SIGNIFICANT.BYTE * 256)
  2230.      LINE.CONTROL.STATUS = INP(LINE.CONTROL.REGISTER)
  2231.      MSB.SAVE = INP(MSB)
  2232.      OUT MSB,0
  2233.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OR 128
  2234.      OUT LSB,LEAST.SIGNIFICANT.BYTE
  2235.      OUT MSB,MOST.SIGNIFICANT.BYTE
  2236.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS
  2237.      OUT MSB,MSB.SAVE
  2238.      END SUB
  2239. 2018 ' $SUBTITLE: 'MSGTO - subroutine to get who a message is to'
  2240. ' $PAGE
  2241. '
  2242. '  NAME    -- MSGTO
  2243. '
  2244. '  INPUTS  --     PARAMETER                    MEANING
  2245. '              HIGHEST.USER.RECORD
  2246. '
  2247. '  OUTPUTS --  MESSAGE.TO$              Who message is to
  2248. '              RECEIVER.REC.NUM         User record # of who to
  2249. '
  2250. '  PURPOSE --  Asks who a message is to and determines if receiver exists
  2251. '
  2252.      SUB MSGTO (HIGHEST.USER.RECORD,MESSAGE.TO$,RECEIVER.REC.NUM,FOUND) STATIC
  2253. 2020 IF MESSAGE.TO$ <> "" THEN _
  2254.         GOTO 2032
  2255.      A$ = "To [A]ll,S)ysop, or name"
  2256.      CALL SKIPLINE (1)
  2257.      GOSUB 2033
  2258.      IF LEN(B$) > 30 THEN _
  2259.         CALL QTPUT1 ("30 Char. Max") : _
  2260.         GOTO 2020
  2261. 2030 FOUND = TRUE
  2262.      IF Q = 0 THEN _
  2263.         MESSAGE.TO$ = "ALL" _
  2264.      ELSE CALL ALLCAPS (B$) : _
  2265.           IF B$ = "A" THEN _
  2266.              MESSAGE.TO$ = "ALL" : _
  2267.              EXIT SUB _
  2268.           ELSE IF B$ = "S" THEN _
  2269.              MESSAGE.TO$ = "SYSOP" _
  2270.           ELSE MESSAGE.TO$ = B$
  2271. 2032 IF MESSAGE.TO$ <> "ALL" THEN _
  2272.         IF (LEFT$(MESSAGE.TO$,4) <> "ALL " AND START.HASH = 1) THEN _ ' KP061602
  2273.            TEMP.HASH.VALUE$ = MESSAGE.TO$ : _
  2274.            CALL WHOCHECK (TEMP.HASH.VALUE$,FOUND,RECEIVER.REC.NUM) : _
  2275.            IF NOT FOUND THEN _
  2276.               Q = 0 : _
  2277.               RECEIVER.REC.NUM = 0 : _
  2278.               A$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  2279.               TURBO.KEY = -TURBO.KEY.USER : _
  2280.               GOSUB 2033 : _
  2281.               Z$ = B$(1) : _
  2282.               CALL ALLCAPS (Z$) : _
  2283.               IF Z$ <> "C" THEN _
  2284.                  MESSAGE.TO$ = "" : _
  2285.                  IF Z$ <> "Q" THEN _
  2286.                     GOTO 2020
  2287.      EXIT SUB
  2288. 2033 SUBROUTINE.PARAMETER = 1
  2289.      CALL TGET
  2290.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2291.         EXIT SUB
  2292.      RETURN
  2293.      END SUB
  2294. 2055 ' $SUBTITLE: 'MSGPROT - gets protection wanted for a message'
  2295. ' $PAGE
  2296. '
  2297. '  NAME    -- MSGPROT
  2298. '
  2299. '  INPUTS  --     PARAMETER                    MEANING
  2300. '                 MESSAGE.TO$
  2301. '                 FOUND
  2302. '
  2303. '  OUTPUTS --  PASSWORD$                Protection desired
  2304. '
  2305. '  PURPOSE --  Sets protection desired for a new message
  2306. '
  2307.      SUB MSGPROT (MESSAGE.TO$,FOUND,MESSAGE.PASSWORD$) STATIC
  2308.      IF MESSAGE.TO$ = "ALL" THEN _
  2309.         GOTO 2090
  2310. 2060 A$ = "Make message p[U]blic, p(R)ivate, (P)assword protected, (H)elp"
  2311.      GOSUB 2093
  2312.      IF Q = 0 THEN _
  2313.         B$(1) = "U"
  2314.      Z$ = LEFT$(B$(1),1)
  2315.      CALL ALLCAPS (Z$)
  2316.      ON INSTR("RUPH",Z$) GOTO 2075,2090,2075,2070
  2317.      GOTO 2060
  2318. '
  2319. ' **  DISPLAY MESSAGE PROTECT HELP   *
  2320. '
  2321. 2070 CALL BUFFILE (HELP$(3),X)
  2322.      GOTO 2060
  2323. '
  2324. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) *
  2325. '
  2326. 2075 IF MESSAGE.TO$ = "ALL" THEN _
  2327.         CALL QTPUT1 ("Msg to ALL cannot be private") : _
  2328.         GOTO 2060
  2329.      IF Z$ = "P" THEN _
  2330.         GOTO 2088
  2331. 2081 CALL QTPUT1 ("Sending personal mail to " + MESSAGE.TO$)
  2332. 2084 MESSAGE.PASSWORD$ = "^READ^"
  2333.      EXIT SUB
  2334. 2085 A$ = "Password"
  2335.      GOSUB 2094
  2336.      IF Q = 0 THEN _
  2337.         GOTO 2085
  2338.      IF LEN(B$) > L THEN _
  2339.         CALL QTPUT1 (STR$(L) + " Chars. max") : _
  2340.         GOTO 2085
  2341.      IF L = 15 AND LEFT$(B$,1) = "!" THEN _
  2342.         CALL QTPUT1 ("Password can't begin with '!'") : _
  2343.         GOTO 2085
  2344.      RETURN
  2345. '
  2346. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
  2347. '
  2348. 2088 A$ = "Receiver(s) Must KNOW PASSWORD TO READ msg.  Use password (Y/[N])"
  2349.      GOSUB 2093
  2350.      IF NOT YES THEN _
  2351.         GOTO 2070
  2352.      L = 14
  2353.      A1$ = "!"
  2354.      GOSUB 2085
  2355.      CALL ALLCAPS (B$)
  2356.      GOTO 2092
  2357. '
  2358. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
  2359. '
  2360. 2090 L = 15
  2361.      A1$ = ""
  2362.      B$ = "^KILL^"
  2363. 2092 MESSAGE.PASSWORD$ = A1$ + _
  2364.                          B$
  2365.      EXIT SUB
  2366. 2093 TURBO.KEY = -TURBO.KEY.USER
  2367. 2094 SUBROUTINE.PARAMETER = 1
  2368.      CALL TGET
  2369.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2370.         EXIT SUB
  2371.      RETURN
  2372.      END SUB
  2373. 2250 ' $SUBTITLE: 'WHOCHECK - Checks whether user exists'
  2374. ' $PAGE
  2375. '
  2376. '  NAME    -- WHOCHECK
  2377. '
  2378. '  INPUTS  --   PARAMETER                    MEANING
  2379. '              WHO.FIND$                User to find
  2380. '
  2381. '  OUTPUTS --  WHO.FOUND                Whether user found
  2382. '              USER.NUM.FOUND           Record # of user
  2383. '
  2384. '  PURPOSE --  Validate that user record exists.  Sysop
  2385. '              counted as found even if lack user record.
  2386. '
  2387.      SUB WHOCHECK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC
  2388.      USER.NUM.FOUND = 0
  2389.      IF START.HASH <> 1 THEN _
  2390.         WHO.FOUND = TRUE : _
  2391.         EXIT SUB
  2392.      WHO.FOUND = FALSE
  2393.      TO.SYSOP = (INSTR(WHO.FIND$,"SYSOP") > 0 OR _
  2394.                  INSTR(WHO.FIND$,SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$) > 0 )
  2395.      CALL OPENUSER (HIGHEST.USER.RECORD)
  2396.      FIELD 5, 128 AS USER.RECORD$
  2397.      IF TO.SYSOP THEN _
  2398.         X$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _
  2399.      ELSE X$ = WHO.FIND$
  2400.      IF LEN(X$) > 1 THEN _                                           ' KG073001
  2401.         CALL FINDUSER (X$,"",START.HASH,LEN.HASH,_                   ' KG073001
  2402.                        0,0,HIGHEST.USER.RECORD,WHO.FOUND,_
  2403.                        USER.NUM.FOUND,SL)
  2404.      IF USER.FILE.INDEX > 0 THEN _
  2405.         GET 5, USER.FILE.INDEX
  2406.      IF NOT WHO.FOUND THEN _
  2407.         IF TO.SYSOP THEN _
  2408.            WHO.FOUND = TRUE _
  2409.         ELSE CALL QTPUT1 (WHO.FIND$ + " not active user")
  2410.      END SUB
  2411. 2618 ' $SUBTITLE: 'EDITALINE - Edits a line in a message'
  2412. ' $PAGE
  2413. '
  2414. '  NAME    -- EDITALINE
  2415. '
  2416. '  INPUTS  --     PARAMETER                    MEANING
  2417. '                 L                        Line # to edit
  2418. '
  2419. '  OUTPUTS --  A$(L)                    Edited line
  2420. '
  2421. '  PURPOSE --  Edit a line in a message.
  2422. '
  2423.      SUB EDITALINE (L) STATIC
  2424. 2620 A$ = "Line #" + _
  2425.           STR$(L) + _
  2426.           " is:" + _
  2427.           RETURN.LINE.FEED$ + _
  2428.           A$(L)
  2429.      SUBROUTINE.PARAMETER = 3
  2430.      CALL TPUT
  2431.      GOSUB 2695
  2432.      IF NOT EXPERT.USER THEN _
  2433.         CALL QTPUT1 ("Search & replace")
  2434.      A$ = "Search for" + _
  2435.           PRESS.ENTER.EXPERT$
  2436.      MACRO.MIN = 99
  2437.      PARSE.OFF = TRUE
  2438.      SUBROUTINE.PARAMETER = 1
  2439.      GOSUB 2694
  2440.      IF Q = 0 THEN _
  2441.         EXIT SUB
  2442.      Y$ = LEFT$(B$,1)
  2443.      IF Y$ = RIGHT$(B$,1) THEN _
  2444.         IF LEN(B$) > 2 THEN _
  2445.            X = INSTR(2,B$,Y$) : _
  2446.            IF X < LEN(B$) THEN _
  2447.               IF Y$ < "0" OR (Y$ > "9" AND Y$ < "A") THEN _
  2448.                  B$ = MID$(B$,2,LEN(B$)-2) : _
  2449.                  X = X - 1 : _
  2450.                  GOTO 2622
  2451.      X = INSTR(B$,";")
  2452. 2622 IF X > 0 THEN _
  2453.         X$ = LEFT$(B$,X-1) : _
  2454.         Y$ = RIGHT$(B$,LEN(B$)-X) : _
  2455.         GOTO 2660
  2456.      X$ = B$
  2457.      A$ = "And replace by"
  2458.      PARSE.OFF = TRUE
  2459.      SUBROUTINE.PARAMETER = 1
  2460.      GOSUB 2694
  2461.      Y$ = B$
  2462. 2660 X = INSTR(1,A$(L),X$)
  2463.      IF X = 0 THEN _
  2464.         CALL QTPUT1 ("<" + X$ + "> not found in line" + STR$(L)) : _
  2465.         GOTO 2620
  2466. 2670 FF = LEN(X$)
  2467.      JJ = LEN(Y$)
  2468.      IF FF = JJ THEN _
  2469.         MID$(A$(L),X) = Y$ : _
  2470.         GOTO 2620
  2471. 2690 DF$ = LEFT$(A$(L),X - 1)
  2472.      A$(L) = DF$ + _
  2473.              Y$ + _
  2474.              MID$(A$(L),X + FF)
  2475.      IF LEN(A$(L)) > RIGHT.MARGIN THEN _
  2476.         CALL WORDWRAP (RIGHT.MARGIN, LINES.IN.MESSAGE, A$())
  2477.      GOTO 2620
  2478. 2694 CALL TGET
  2479. 2695 IF SUBROUTINE.PARAMETER > -1 THEN _
  2480.         RETURN
  2481.      END SUB
  2482. 3700 ' $SUBTITLE: 'LINEEDIT  - subroutine to produce edited line'
  2483. ' $PAGE
  2484. '
  2485. '  NAME    -- LINEEDIT
  2486. '
  2487. '  INPUTS  -- PARAMETER             MEANING
  2488. '             BACK.ARROW$
  2489. '             BACKSPACE$
  2490. '             CARRIAGE.RETURN$
  2491. '             LINE.FEED$
  2492. '             LINEMES$          BUFFER SPACE TO USE FOR HOLDING LINE
  2493. '             LOCAL.USER
  2494. '             MAX.LEN           MAXIMUM LENGTH OF STRING TO INPUT
  2495. '             MESSAGE.LINE      WHERE IN A$() TO PUT THE EDITED LINE
  2496. '             RIGHT.MARGIN
  2497. '             SNOOP
  2498. '             STOP.INTERRUPTS
  2499. '             WAIT.EXPIRED
  2500. '
  2501. '  OUTPUTS -- A$(MESSAGE.LINE)  EDITED LINE
  2502. '
  2503. '  PURPOSE -- Subroutine to edit a line quickly using a minimum of
  2504. '             string space.
  2505. '
  2506.      SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC
  2507.      LSET LINEMES$ = A$(MESSAGE.LINE)
  2508.      COL = LEN(A$(MESSAGE.LINE))
  2509.      STOP.INTERRUPTS = TRUE
  2510.      XXX = MAX.LEN - 3
  2511.      WAIT.EXPIRED = FALSE
  2512.      GOTO 3782
  2513. 3720 COL = COL + 1
  2514.      CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT)
  2515. 3730 CALL FINDFUNC
  2516.      IF SUBROUTINE.PARAMETER < 0 THEN _
  2517.         EXIT SUB
  2518.      X$ = KEY.PRESSED$
  2519.      IF X$ = "" THEN _
  2520.         IF LOCAL.USER THEN _
  2521.            GOTO 3730 _
  2522.         ELSE GOTO 3732
  2523.      IF X$ = ESCAPE$ THEN _
  2524.         KEY.PRESSED$ = X$ : _
  2525.         EXIT SUB
  2526.      SEND.REMOTE = TRUE
  2527.      Z = INSTR(LINEEDIT.CHK$,X$)
  2528.      IF Z < 1 THEN _
  2529.         GOTO 3750 _
  2530.      ELSE IF Z > 4 THEN _
  2531.              GOTO 3870
  2532.      IF LOCAL.USER THEN _
  2533.         GOTO 3730
  2534. 3732 IF COMMPORT.STACK$ <> "" THEN _
  2535.         X$ = LEFT$(COMMPORT.STACK$,1) : _
  2536.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  2537.         GOTO 3738
  2538.      CALL EOFCOMM (CHAR%)
  2539.      IF CHAR% <> -1 THEN _
  2540.         GOTO 3736
  2541.      CALL FINDTIME (TI!)
  2542.      IF TI! > AUTO.LOGOFF! THEN _
  2543.         WAIT.EXPIRED = TRUE : _
  2544.         EXIT SUB
  2545. 3733 CALL CARRIER
  2546.      IF SUBROUTINE.PARAMETER THEN _
  2547.         EXIT SUB
  2548.      GOTO 3730
  2549. 3736 AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  2550. 3737 CALL GETCOM (X$)
  2551. 3738 SEND.REMOTE = REMOTE.ECHO
  2552. 3740 ON INSTR(LINEEDIT.CHK$,X$) GOTO 3730,3730,3730,3730,3870,3870,3870,3870,3870
  2553. 3750 IF SEND.REMOTE THEN _
  2554.         CALL PUTCOM(X$)
  2555.      CALL LPRNT (X$, 0)
  2556.      IF X$ = CARRIAGE.RETURN$ THEN _
  2557.         COL = COL - 1 : _
  2558.         GOTO 3850
  2559. 3770 IF COL > XXX THEN _
  2560.         IF X$ = " " THEN _
  2561.            CALL SKIPLINE (1) : _
  2562.            GOTO 3860
  2563. 3780 MID$(LINEMES$,COL) = X$
  2564. 3782 IF COL < MAX.LEN THEN _
  2565.         GOTO 3720
  2566.      Z = COL
  2567. 3800 IF Z < 1 THEN _
  2568.         Z = COL-1 : _
  2569.         GOTO 3820
  2570.      IF MID$(LINEMES$,Z,1) = " " THEN _
  2571.         GOTO 3820
  2572.      Z = Z - 1
  2573.      GOTO 3800
  2574. 3820 IF (NOT REMOTE.ECHO) AND (NOT LOCAL.USER) THEN _
  2575.         CALL SKIPLINE (1) : _
  2576.         GOTO 3860
  2577.      COL = MAX.LEN - Z
  2578.      IF SNOOP THEN _
  2579.         IF (POS(0) > COL) AND (COL > 0) THEN _
  2580.            LOCATE ,POS(0)-COL: _
  2581.            CALL LPRNT(STRING$(COL,32),0)
  2582. 3830 IF REMOTE.ECHO THEN _
  2583.         CALL PUTCOM (STRING$(COL,8) + STRING$(COL,32))
  2584. 3840 A$(MESSAGE.LINE) = LEFT$(LINEMES$,Z)
  2585.      A$(MESSAGE.LINE + 1) = MID$(LINEMES$,Z + 1,COL)
  2586.      CALL SKIPLINE (1)
  2587.      GOTO 3891
  2588. 3850 IF SEND.REMOTE AND LINE.FEEDS THEN _
  2589.         CALL PUTCOM(LINE.FEED$)
  2590. 3860 A$(MESSAGE.LINE) = LEFT$(LINEMES$,COL)
  2591.      GOTO 3891
  2592. 3870 IF COL = 1 THEN _
  2593.         GOTO 3730
  2594.      COL = COL-2
  2595. 3880 CALL LPRNT(LOCAL.BACKSPACE$,0)
  2596. 3885 IF SEND.REMOTE THEN _
  2597.         CALL PUTCOM (BACKSPACE$)
  2598. 3890 GOTO 3720
  2599. 3891 CALL CARRIER
  2600.      END SUB
  2601. 3952 ' $SUBTITLE: 'KILLMSG - subroutine to delete messages'
  2602. ' $PAGE
  2603. '
  2604. '  NAME    -- KILLMSG
  2605. '
  2606. '  INPUTS  --     PARAMETER                    MEANING
  2607. '              MESSAGE.TO.KILL              MESSAGE NUMBER TO KILL
  2608. '              ACTIVE.MESSAGES              NUMBER ACTIVE MESSAGES
  2609. '
  2610. '  OUTPUTS --  NONE
  2611. '
  2612. '  PURPOSE --  To kill/delete old or unnecessary messages
  2613. '
  2614.      SUB KILLMSG (MESSAGE.TO.KILL,ACTIVE.MESSAGES) STATIC
  2615. '
  2616.      FIELD #1,128 AS MESSAGE.RECORD$
  2617.      QX = 1
  2618. 3955 IF QX > ACTIVE.MESSAGES THEN _
  2619.         A$ = "No such msg #" + _
  2620.              STR$(MESSAGE.TO.KILL) : _
  2621.         GOTO 4031
  2622.      IF M(QX,2) = MESSAGE.TO.KILL AND MESSAGE.TO.KILL => 1 THEN _
  2623.         GOTO 3970
  2624.      QX = QX + 1
  2625.      GOTO 3955
  2626. 3970 SUBROUTINE.PARAMETER = 3
  2627.      CALL FILELOCK
  2628.      GET 1,M(QX,1)
  2629.      IF USER.SECURITY.LEVEL >= SEC.KILL.ANY THEN _
  2630.         GOTO 4030
  2631. 3980 Z$ = MID$(MESSAGE.RECORD$,101,15)
  2632.      CALL TRIM (Z$)
  2633.      IF LEN(Z$) = 0 THEN _
  2634.         GOTO 4030
  2635. 3990 IF Z$ = "^READ^" OR Z$ = "^KILL^" THEN _
  2636.         IF (INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) > 0 _
  2637.            OR USER.SECURITY.LEVEL >= SEC.KILL.ANY) THEN _
  2638.            GOTO 4030 _
  2639.         ELSE MESSAGE.PASSWORD = TRUE : _
  2640.              ATTEMPTS.ALLOWED = 0 : _
  2641.              A$ = "Only sender & receiver can kill" : _
  2642.              GOTO 4031
  2643. 4000 IF LEFT$(Z$,1) = "!" THEN _
  2644.         Z$ = MID$(Z$,2)
  2645. 4010 PASSWORD.SAVE$ = Z$ + _
  2646.                       SPACE$(15 - LEN(Z$))
  2647.      ATTEMPTS.ALLOWED = 1
  2648.      MESSAGE.PASSWORD = TRUE
  2649.      CALL PASSWRD
  2650.      IF PASSWORD.FAILED THEN _
  2651.         GOTO 4031
  2652. 4030 MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$
  2653.      PUT 1,LOC(1)
  2654.      SUBROUTINE.PARAMETER = 4
  2655.      CALL FILELOCK
  2656.      A$ = "Killed Msg # " + _
  2657.           STR$(MESSAGE.TO.KILL)
  2658.      CALL UPDTCALR (A$,1)
  2659. 4031 SUBROUTINE.PARAMETER = 5
  2660.      CALL TPUT
  2661.      END SUB
  2662. 4554 ' $SUBTITLE: 'SETTHREAD - Sets up the interface for threading'
  2663. ' $PAGE
  2664. '
  2665. '  NAME    -- SETTHREAD
  2666. '
  2667. '  INPUTS  --     PARAMETER                    MEANING
  2668. '                 CURR.MSG.NUM          Current message number
  2669. '                 CURR.SUBJ$            Current message subject
  2670. '
  2671. '  OUTPUTS --  B$()                   Search msg by string
  2672. '              Q                      0 if thread cancelled
  2673. '
  2674. '  PURPOSE --  Find out how the caller wants to thread -
  2675. '              i.e. search messages by matching subject -
  2676. '              forward from current, back from current,
  2677. '              or forward from top of messages
  2678. '
  2679.      SUB SETTHREAD (CURR.MSG.NUM,CURR.SUBJ$) STATIC
  2680.      IF Q > 1 THEN _
  2681.         Z$ = B$(2) : _
  2682.         GOTO 4657
  2683. 4656 A$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)"
  2684.      TURBO.KEY = -TURBO.KEY.USER
  2685.      SUBROUTINE.PARAMETER = 1
  2686.      CALL TGET
  2687.      IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _
  2688.         EXIT SUB
  2689.      Z$ = B$(1)
  2690. 4657 Z$ = LEFT$(Z$,1)
  2691.      X = INSTR("+-1",Z$)
  2692.      IF X = 0 THEN _
  2693.         GOTO 4656
  2694.      B$(1) = "R"
  2695.      IF X = 1 THEN _
  2696.         CURR.MSG.NUM = CURR.MSG.NUM + 1 _
  2697.      ELSE IF X = 2 THEN _
  2698.              CURR.MSG.NUM = CURR.MSG.NUM - 1 _
  2699.           ELSE CURR.MSG.NUM = 1 : _
  2700.                Z$ = "+"
  2701.      B$(3) = MID$(STR$(CURR.MSG.NUM),2) + Z$
  2702.      IF LEN(CURR.SUBJ$) < 4 OR LEFT$(CURR.SUBJ$,3) <> "(R)" THEN _
  2703.         B$(2) = CURR.SUBJ$ _
  2704.      ELSE B$(2) = MID$(CURR.SUBJ$,4)
  2705.      B$(2) = CHR$(34) + B$(2) + CHR$(34)
  2706.      Q = 3
  2707.      END SUB
  2708. 4773 ' $SUBTITLE: 'SYSOPCHAT - chat with sysop'
  2709. ' $PAGE
  2710. '
  2711. '  NAME    -- SYSOPCHAT
  2712. '
  2713. '  INPUTS  --     PARAMETER                    MEANING
  2714. '  OUTPUTS --  CM                     True if chat active
  2715. '
  2716. '  PURPOSE --  Lets sysop chat interactively with caller
  2717. '
  2718.      SUB SYSOPCHAT STATIC
  2719.      CM = TRUE
  2720.      CALL FINDTIME (TIME.CHAT.STARTED!)
  2721.      SUBROUTINE.PARAMETER = 1
  2722.      CALL LINE25
  2723.      A$(2) = ""
  2724. 4775 CALL LINEEDIT (1,72)
  2725.      IF KEY.PRESSED$ = ESCAPE$ OR _
  2726.         SUBROUTINE.PARAMETER < 0 THEN _
  2727.         GOTO 4777
  2728.      A$(1) = ""
  2729.      IF A$(2) <> "" THEN _
  2730.         A$ = A$(2) : _
  2731.         A$(1) = A$(2) : _
  2732.         A$(2) = "" _
  2733.      ELSE A$ = ""
  2734.      SUBROUTINE.PARAMETER = 4
  2735.      CALL TPUT
  2736.      IF SUBROUTINE.PARAMETER > -1 THEN _
  2737.         GOTO 4775
  2738. 4777 CM = 0
  2739.      CALL FINDTIME (TI!)
  2740.      ELAPSED! = FIX(TI! - TIME.CHAT.STARTED!)
  2741.      IF ELAPSED! < 0 THEN _
  2742.         ELAPSED! = TI! + (86400! - TIME.CHAT.STARTED!)
  2743.      SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + ELAPSED!
  2744.      IF NOT LOCAL.USER THEN _
  2745.         AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  2746.      CALL QTPUT("  Chat ended.  Returning to normal operation",2)
  2747.      END SUB
  2748. 5100 ' $SUBTITLE: 'REMNONALF - removes non-alpha chars from a string'
  2749. ' $PAGE
  2750. '
  2751. '  NAME    -- REMNONALF
  2752. '
  2753. '  INPUTS  --     PARAMETER                    MEANING
  2754. '                 STRNG$                   String to check
  2755. '                 MIN.CHAR            Remove chars with this
  2756. '                                     ASCII value or lower
  2757. '                 MAX.CHAR            Remove chars with this
  2758. '                                     ASCII value or higher
  2759. '
  2760. '  OUTPUTS --       STRNG$                   String returned
  2761. '  PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2762. '
  2763.      SUB REMNONALF (STRNG$,MIN.CHAR,MAX.CHAR) STATIC
  2764.      LAST = LEN(STRNG$)
  2765.      J = 1
  2766.      WHILE J <= LAST
  2767.         K = ASC(MID$(STRNG$,J))
  2768.         IF K > MIN.CHAR AND K < MAX.CHAR THEN _
  2769.            J = J + 1 _
  2770.         ELSE STRNG$ = LEFT$(STRNG$,J - 1) + _
  2771.                       RIGHT$(STRNG$,LAST - J) : _
  2772.              LAST = LAST - 1
  2773.      WEND
  2774.      END SUB
  2775. 5200 ' $SUBTITLE: 'PAGELEN - Sets lines per page'
  2776. ' $PAGE
  2777. '
  2778. '  NAME    -- PAGELEN
  2779. '
  2780. '  INPUTS  --     PARAMETER                    MEANING
  2781. '               PAGE.LENGTH              Current page length
  2782. '
  2783. '  OUTPUTS --   PAGE.LENGTH              New page length
  2784. '
  2785. '  PURPOSE --  Change default lines per page
  2786. '
  2787.      SUB PAGELEN STATIC
  2788. 5202 A$ = "CHANGE page length from" + _
  2789.           STR$(PAGE.LENGTH) + _
  2790.           " TO (0-255, 0=continuous)"
  2791.      SUBROUTINE.PARMETER = 5
  2792.      CALL TGET
  2793.      IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _
  2794.         CALL QTPUT1 ("No change") : _
  2795.         EXIT SUB
  2796. 5230 CALL CHECKINT (B$(Q))
  2797.      IF EC <> 0 THEN _
  2798.         GOTO 5202
  2799.      IF TESTED.INTEGER.VALUE < 0 OR _
  2800.         TESTED.INTEGER.VALUE > 255 THEN _
  2801.         GOTO 5202
  2802.      PAGE.LENGTH = TESTED.INTEGER.VALUE
  2803.      CALL QTPUT1 ("Set to" + STR$(PAGE.LENGTH))
  2804.      END SUB
  2805. 5507 ' $SUBTITLE: 'BAUD450 -- Changes 300 baud to 450'
  2806. ' $PAGE
  2807. '  NAME    -- BAUD450
  2808. '
  2809. '  INPUTS  -- PARAMETER             MEANING
  2810. '             BPS
  2811. '
  2812. '  OUTPUTS -- BPS
  2813. '
  2814. '  PURPOSE -- Allow 300 baud modems to bump up to 450 baud
  2815. '
  2816.      SUB BAUD450 STATIC
  2817.      IF BPS <> -1 THEN _
  2818.         CALL QTPUT1 ("Sorry, only 300 baud can change speed") : _
  2819.         EXIT SUB
  2820.      IF FOSSIL THEN _
  2821.         CALL QTPUT1 ("Sorry, 450 baud NOT supported under FOSSIL") : _
  2822.         EXIT SUB
  2823.      A$ = "Change to 450 baud (Y,[N])"
  2824.      TURBO.KEY = -TURBO.KEY.USER
  2825.      SUBROUTINE.PARAMETER = 1
  2826.      CALL TGET
  2827.      IF SUBROUTINE.PARAMETER = -1 OR NOT YES THEN _
  2828.         EXIT SUB
  2829. 5510 CALL QTPUT1 ("Change your baud rate to 450")
  2830.      CALL DELAYIT (9)
  2831.      C = 0
  2832.      BPS = -2
  2833.      CALL SETBAUD
  2834.      A$ = " and then press [ENTER] until I respond"
  2835.      SUBROUTINE.PARAMETER = 9
  2836.      CALL TGET
  2837. 5530 C = C + 1
  2838.      CALL CARRIER
  2839.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2840.         EXIT SUB
  2841.      IF C = 20 THEN _
  2842.         CALL UPDTCALR ("Baud change failed",1) : _
  2843.         BPS = -1 : _
  2844.         CALL SETBAUD : _
  2845.         EXIT SUB
  2846.      CALL DELAYIT (1)
  2847. 5535 CALL EOFCOMM (CHAR%)
  2848.      IF CHAR% = -1 THEN _
  2849.         GOTO 5530
  2850. 5536 CALL PUTCOM(A$)
  2851.      IF A$ = "" THEN _
  2852.         A$ = " "
  2853.      IF ASC(A$) = 13 THEN _
  2854.         GOTO 5540
  2855.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2856.         EXIT SUB
  2857. 5537 GOTO 5530
  2858. 5540 A$ = "Changed to 450 baud"
  2859.      CALL QTPUT1 (A$)
  2860.      CALL UPDTCALR (A$,1)
  2861.      BPS = -2
  2862.      A$ = ""
  2863.      END SUB
  2864. 9140 ' $SUBTITLE: 'GETIME - subroutine to calculate elapsed time'
  2865. ' $PAGE
  2866. '
  2867. '  NAME    -- GETIME
  2868. '
  2869. '  INPUTS  --     PARAMETER                    MEANING
  2870. '                TIME.LOGGED.ON$
  2871. '
  2872. '  OUTPUTS --  HH                     NUMBER OF HOURS ON
  2873. '              MM                     NUMBER OF MINUTES ON
  2874. '              SS                     NUMBER OF SECONDS ON
  2875. '
  2876. '  PURPOSE --  Calculate the elapsed time a user has been on
  2877. '
  2878.      SUB GETIME STATIC
  2879.      H = VAL(MID$(TIME.LOGGED.ON$,1,2))
  2880.      M = VAL(MID$(TIME.LOGGED.ON$,4,2))
  2881.      S = VAL(MID$(TIME.LOGGED.ON$,7,2))
  2882.      X$ = TIME$
  2883.      HH = VAL(MID$(X$,1,2))
  2884.      MM = VAL(MID$(X$,4,2))
  2885.      JJ = VAL(MID$(X$,7,2))
  2886.      IF S <= JJ THEN _
  2887.         SSS = JJ - S _
  2888.      ELSE SSS = 60 - (S - JJ) : _
  2889.           M = M + 1
  2890. 9150 IF M <= MM THEN _
  2891.         MMM = MM - M _
  2892.      ELSE MMM = 60 - (M - MM) : _
  2893.           H = H + 1
  2894. 9160 IF H <= HH THEN _
  2895.         HHH = HH - H _
  2896.      ELSE HHH = 24 - (H - HH)
  2897.      END SUB
  2898. 9600 ' $SUBTITLE: 'DEFAULTU - subroutine to update user defauts'
  2899. ' $PAGE
  2900. '
  2901. '  NAME    -- DEFAULTU
  2902. '
  2903. '  INPUTS  --     PARAMETER                    MEANING
  2904. '             AUTODOWNLOAD.DESIRED
  2905. '             BOLD.TEXT$              Ansi bold (0 no, 1 yes)
  2906. '             CHECK.BULLETIN.LOGON
  2907. '             EXPERT.USER
  2908. '             GR
  2909. '             LAST.MESSAGE.READ
  2910. '             LINE.FEEDS
  2911. '             NULLS
  2912. '             PAGE.LENGTH
  2913. '             PROMPT.BELL
  2914. '             REG.DATE$
  2915. '             REQ.QUES.ANSWERED
  2916. '             RIGHT.MARGIN
  2917. '             SKIP.FILES.LOGON
  2918. '             TIMES.LOGGED.ON
  2919. '             UPPER.CASE
  2920. '             USER.OPTIONS$
  2921. '             USER.TEXT.COLOR          Ansi of color (31-37)
  2922. '             USER.TRANSFER.DEFAULT$
  2923. '
  2924. '  OUTPUTS--  USER.OPTONS$
  2925. '
  2926. '  PURPOSE --  To update the user's record with their options.
  2927. '  Meaning of graphics preference stored is as follows: where # is
  2928. '  value stored for the color.  E.g. if graphics perference for text
  2929. '  files is color, and preference for normal text is light yellow,
  2930. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  2931. '  Blue, Purple, Cyan, and White.
  2932. '
  2933. '             normal                  bold
  2934. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  2935. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  2936. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  2937. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  2938. '
  2939.      SUB DEFAULTU STATIC
  2940.      A =        -PROMPT.BELL           -2 * EXPERT.USER _
  2941.             -4 * NULLS                 -8 * UPPER.CASE _
  2942.            -16 * LINE.FEEDS           -32 * CHECK.BULLETIN.LOGON _
  2943.            -64 * SKIP.FILES.LOGON    -128 * AUTODOWNLOAD.DESIRED _
  2944.           -256 * REQ.QUES.ANSWERED   -512 * MAIL.WAITING _
  2945.          -1024 * (NOT HIGHLIGHT.OFF)-2048 * TURBO.KEY.USER
  2946.      X = 3*USER.TEXT.COLOR - 63 + 21*VAL(BOLD.TEXT$) + GR
  2947.      IF X < 1 OR X > 255 THEN _
  2948.         X = 48
  2949.      LSET USER.OPTIONS$ = _
  2950.         MKI$(TIMES.LOGGED.ON) + _
  2951.         MKI$(LAST.MESSAGE.READ) + _
  2952.         USER.TRANSFER.DEFAULT$ + _
  2953.         CHR$(X) + _
  2954.         MKI$(RIGHT.MARGIN) + _
  2955.         MKI$(A) + _
  2956.         REG.DATE$ + _
  2957.         CHR$(PAGE.LENGTH) + _
  2958.         ECHOER$
  2959.      END SUB
  2960. 9801 ' $SUBTITLE: 'WHOSON - subroutine to display who is on'
  2961. ' $PAGE
  2962. '
  2963. '  NAME    -- WHOSON
  2964. '
  2965. '  INPUTS  --     PARAMETER                    MEANING
  2966. '                NUM.NODES                   # of nodes to check
  2967. '                ACTIVE.MESSAGE.FILE$        Current message file
  2968. '                ORIG.MESSAGE.FILE$          Main msg file
  2969. '
  2970. '  OUTPUTS --  None
  2971. '
  2972. '  PURPOSE --  To display who is on each node.
  2973. '
  2974.      SUB WHOSON (NUM.NODES) STATIC
  2975.      A1$ = ACTIVE.MESSAGE.FILE$
  2976.      ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  2977.      CALL OPENMSG
  2978.      FIELD 1, 128 AS MESSAGE.RECORD$
  2979.      FOR NODE.INDEX = 2 TO NUM.NODES + 1
  2980.         GET 1,NODE.INDEX
  2981.         A$ = FG.1$ + "Node" + _
  2982.              STR$(NODE.INDEX - 1) + FG.2$
  2983.         REC.INDEX = VAL(MID$(MESSAGE.RECORD$,44,2))
  2984.         IF REC.INDEX = 0 THEN _
  2985.            REC.INDEX = -1
  2986.         AX$ = MID$("      300  450 1200 2400 4800 960019200",(-5 * REC.INDEX ),5) + _
  2987.               " BAUD: "
  2988.         IF MID$(MESSAGE.RECORD$,55,2) = "-1" AND NOT SYSOP THEN _
  2989.            Y$ = "SYSOP" + SPACE$(21) _
  2990.         ELSE Y$ = MID$(MESSAGE.RECORD$,1,26)
  2991.         AX$ = AX$ + FG.3$ + Y$
  2992.         IF MID$(MESSAGE.RECORD$,40,2) <> "-1" THEN _
  2993.            AX$ = AX$ + FG.4$ + MID$(MESSAGE.RECORD$,93,22)
  2994.         IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _
  2995.            A$ = A$ + "  Online at " + _
  2996.                 AX$ _
  2997.         ELSE IF NOT SYSOP THEN _
  2998.                 A$ = A$ + _
  2999.                      " Waiting for next caller" _
  3000.              ELSE A$ = A$ + _
  3001.                        " Offline at " + _
  3002.                        AX$
  3003.         CALL QTPUT1 (A$)
  3004.      NEXT
  3005.      ACTIVE.MESSAGE.FILE$ = A1$
  3006.      CALL QTPUT (EMPHASIZE.OFF$,0)                                   ' MZ060303
  3007.      END SUB
  3008. 10410 ' $SUBTITLE: 'RECOVMSG - sub to recover deleted messages'
  3009. ' $PAGE
  3010. '
  3011. '  NAME    -- RECOVMSG
  3012. '
  3013. '  INPUTS  --     PARAMETER                    MEANING
  3014. '               MESSAGE.TO.RECOVER          MESSAGE NUMBER TO RECOVER
  3015. '               FIRST.MESSAGE.RECORD        RECORD # FOR FIRST MSG
  3016. '
  3017. '  OUTPUTS --  ACTION.FLAG                 SET TO 0 IF ERROR
  3018. '                                          SET TO -1 IF NO ERROR
  3019. '
  3020. '  PURPOSE --  To recover deleted messages.  Note that this is only
  3021. '              possible if you have not compressed your message file
  3022. '              using config.
  3023. '
  3024.       SUB RECOVMSG (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG) STATIC
  3025.       FIELD #1,128 AS MESSAGE.RECORD$
  3026.       MESSAGE.RECORD = FIRST.MESSAGE.RECORD
  3027.       SUBROUTINE.PARAMETER = 5
  3028.       CALL TPUT
  3029. 10420 GET 1,MESSAGE.RECORD
  3030.       NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,117,4))
  3031.       IF NUMBER.RECORDS.IN.MESSAGE < 1 THEN _
  3032.          A$ = "USE CONFIG TO REPAIR YOUR MESSAGE FILE" : _
  3033.          GOTO 10485
  3034.       IF MESSAGE.RECORD => NEXT.MESSAGE.RECORD THEN _
  3035.          A$ = "No Msg #" + _
  3036.               STR$(MESSAGE.TO.RECOVER) : _
  3037.          GOTO 10485
  3038. 10440 IF VAL(MID$(MESSAGE.RECORD$,2,4)) <> MESSAGE.TO.RECOVER THEN _
  3039.          MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE : _
  3040.          GOTO 10420
  3041. 10450 IF INSTR(MESSAGE.RECORD$,DELETED.MESSAGE$) <> 0 THEN _
  3042.          SUBROUTINE.PARAMETER = 3 : _
  3043.          CALL TPUT : _
  3044.          LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _
  3045.                                 ACTIVE.MESSAGE$ + _
  3046.                                 MID$(MESSAGE.RECORD$,117) : _
  3047.          PUT 1,LOC(1) : _
  3048.          SUBROUTINE.PARAMETER = 4 : _
  3049.          CALL TPUT : _
  3050.          A$ = "Restored Msg #" + _
  3051.               STR$(MESSAGE.TO.RECOVER) : _
  3052.          ACTION.FLAG = TRUE : _
  3053.          GOTO 10485
  3054. 10480 A$ = "Msg #" + _
  3055.            STR$(MESSAGE.TO.RECOVER) + _
  3056.            " not Dead"
  3057. 10485 CALL QTPUT1 (A$)
  3058.       END SUB
  3059. 10600 ' $SUBTITLE: 'UPDATEU -- Update the users record at logoff'
  3060. ' $PAGE
  3061. '  NAME    -- UPDATEU
  3062. '
  3063. '  INPUTS  -- PARAMETER             MEANING
  3064. '             ADJUSTED.SECURITY
  3065. '             CURRENT.DATE$
  3066. '             DOWNLOADS
  3067. '             ELAPSED.TIME
  3068. '             LIST.DIRECTORY
  3069. '             MAIN.USER.FILE.INDEX
  3070. '             SECONDS.PER.SESSION!
  3071. '             UPLOADS
  3072. '             USER.SECURITY.LEVEL
  3073. '
  3074. '  OUTPUTS -- ELAPSED.TIME$
  3075. '             LIST.NEW.DATE$
  3076. '             SECURITY.LEVEL$
  3077. '             USER.DOWNLOADS$
  3078. '             USER.UPLOADS$
  3079. '
  3080. '  PURPOSE -- Update the user record for the user when the user
  3081. '             exits RBBS-PC.
  3082. '
  3083.       SUB UPDATEU (LOGGING.OFF) STATIC
  3084.       IF ACTIVE.USER.NAME$ = "" OR FIRST.NAME$ = "" THEN _
  3085.          EXIT SUB
  3086.       IF ACTIVE.USER.FILE$ = ORIG.USER.FILE$ THEN _
  3087.          UPLOADS = GLOBAL.UPLOADS : _
  3088.          DOWNLOADS = GLOBAL.DOWNLOADS : _
  3089.          DL.TODAY! = GLOBAL.DL.TODAY! : _
  3090.          BYTES.TODAY! = GLOBAL.BYTES.TODAY! : _
  3091.          DLBYTES! = GLOBAL.DLBYTES! : _
  3092.          ULBYTES! = GLOBAL.ULBYTES!
  3093.       CALL TIMEREMAIN (TIME.REMAINING!)
  3094.       Q! = ELAPSED.TIME + _                                          ' KP061804
  3095.            ((SECONDS.PER.SESSION! - TIME.CREDITS!)/ 60) - _
  3096.            TIME.REMAINING!
  3097.       IF Q! < -32000 THEN _
  3098.          Q! = -32000 _
  3099.       ELSE IF Q! > 32000 THEN _
  3100.          Q! = 32000
  3101.       IF USER.FILE.INDEX < 1 THEN _
  3102.          GOTO 10607
  3103.       UPDATE.DEFAULTS = TRUE
  3104. 10602 SUBROUTINE.PARAMETER = 6
  3105.       CALL FILELOCK
  3106.       CALL OPENUSER (HIGHEST.USER.RECORD)
  3107.       FIELD 5,31 AS USER.NAME$, _
  3108.               15 AS PASSWORD$, _
  3109.                2 AS SECURITY.LEVEL$, _
  3110.               14 AS USER.OPTIONS$,  _
  3111.               24 AS CITY.STATE$, _
  3112.               3 AS MACHINE.TYPE$, _
  3113.               4 AS TODAY.DL$, _
  3114.               4 AS TODAY.BYTES$, _
  3115.               4 AS DL.BYTES$, _
  3116.               4 AS UL.BYTES$, _
  3117.               14 AS LAST.DATE.TIME.ON$, _
  3118.                3 AS LIST.NEW.DATE$, _
  3119.                2 AS USER.DOWNLOADS$, _
  3120.                2 AS USER.UPLOADS$, _
  3121.                2 AS ELAPSED.TIME$
  3122. 10604 GET 5,USER.FILE.INDEX
  3123.       IF UPDATE.DEFAULTS THEN _
  3124.          CALL DEFAULTU
  3125.       IF LIST.DIRECTORY THEN _
  3126.          LSET LIST.NEW.DATE$ = CHR$(VAL(MID$(CURRENT.DATE$,7,2))) + _
  3127.                                CHR$(VAL(MID$(CURRENT.DATE$,1,2))) + _
  3128.                                CHR$(VAL(MID$(CURRENT.DATE$,4,2)))
  3129. 10605 LSET USER.DOWNLOADS$ = MKI$(DOWNLOADS)
  3130.       LSET USER.UPLOADS$ = MKI$(UPLOADS)
  3131.       IF ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
  3132.          LSET TODAY.DL$ = MKS$(DL.TODAY!) : _
  3133.          LSET TODAY.BYTES$ = MKS$(BYTES.TODAY!) : _
  3134.          LSET DL.BYTES$ = MKS$(DLBYTES!) : _
  3135.          LSET UL.BYTES$ = MKS$(ULBYTES!)
  3136.       LSET ELAPSED.TIME$ = MKI$(Q!)
  3137.       IF ADJUSTED.SECURITY THEN _
  3138.          LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
  3139.       PUT 5,USER.FILE.INDEX
  3140.       SUBROUTINE.PARAMETER = 8
  3141.       CALL FILELOCK
  3142.       IF ACTIVE.USER.FILE$ <> ORIG.USER.FILE$ AND LOGGING.OFF THEN _
  3143.          ACTIVE.USER.FILE$ = ORIG.USER.FILE$ : _
  3144.          USER.FILE.INDEX = ORIG.USER.FILE.INDEX : _
  3145.          UPDATE.DEFAULTS = FALSE : _
  3146.          GOTO 10602
  3147. 10607 IF EXIT.TO.DOORS OR NOT LOGGING.OFF THEN _
  3148.          EXIT SUB
  3149.       IF MAX.PER.DAY <= 0 THEN _
  3150.          X = MINUTES.PER.SESSION! _
  3151.       ELSE X = (MAX.PER.DAY - Q!) : _
  3152.            X = -(X > 0) * X:
  3153.       CALL QTPUT1 (STR$(X)+" min left for next call today")
  3154.       CALL QTPUT1 (FIRST.NAME$ + ", Thanks and please call again!")
  3155.       IF NOT HIGHLIGHT.OFF THEN _
  3156.          CALL QTPUT1 (COLOR.RESET$)
  3157.       CALL DELAYIT (8 + BPS)
  3158.       END SUB
  3159. 10935 ' $SUBTITLE: 'DOSEXIT -- Setup to exit to DOS for SYSOP'
  3160. ' $PAGE
  3161. '  NAME    -- DOSEXIT
  3162. '
  3163. '  INPUTS  -- PARAMETER             MEANING
  3164. '             COM.PORT$
  3165. '             DOORS.TERMINAL.TYPE
  3166. '             MULTI.LINK.PRESENT
  3167. '             RBBS.BAT$
  3168. '             REDIRECT.IO.METHOD
  3169. '             USE.DEVICE.DRIVER$
  3170. '
  3171. '  OUTPUTS -- Q                    NUMBER OF LINES TO WRITE OUT TO
  3172. '                                  RCTTY.BAT$
  3173. '             B$()                 LINES TO WRITE OUT TO RCTTY.BAT$
  3174. '
  3175. '  PURPOSE -- Set up B$() and Q in order to call "RBBSEXIT" and
  3176. '             exit to DOS for the remote RBBS-PC sysop
  3177. '
  3178.       SUB DOSEXIT STATIC
  3179.       IF MULTI.LINK.PRESENT AND _
  3180.          DOORS.TERMINAL.TYPE > 0 THEN _
  3181.          FF = 0 : _
  3182.          GOTO 10950
  3183.       A$(1) = "ECHO OFF"
  3184.       IF USE.DEVICE.DRIVER$ <> "" THEN _
  3185.          PORT$ = USE.DEVICE.DRIVER$ _
  3186.       ELSE PORT$ = "COM" + RIGHT$(COM.PORT$,1)
  3187.       IF REDIRECT.IO.METHOD THEN _
  3188.          FF = 5 : _
  3189.          A$(2) = "CTTY " + _
  3190.                  PORT$ : _
  3191.          A$(3) = DISK.FOR.DOS$ + _
  3192.                  "COMMAND" : _
  3193.          A$(4) = "CTTY CON" : _
  3194.          A$(5) = RBBS.BAT$ _
  3195.       ELSE FF = 3 : _
  3196.            A$(2) = DISK.FOR.DOS$ + _
  3197.                    "COMMAND >" + _
  3198.                    PORT$ + _
  3199.                    " <" + _
  3200.                    PORT$ : _
  3201.            A$(3) = RBBS.BAT$
  3202. 10950 CALL AMORPMTD                                                  ' KG061203
  3203.       CALL UPDTCALR ("Exited to DOS at " + TIM$,2)
  3204.       CALL QTPUT1 ("RBBS-PC " + VERSION.ID$)
  3205.       CALL QTPUT1 ("SYSOP in Remote Console Mode")
  3206.       CALL RBBSEXIT (A$(),FF)
  3207.       END SUB
  3208. 10976 ' $SUBTITLE: 'WORDINFILE -- Searches a file to find a word'
  3209. ' $PAGE
  3210. '  NAME    -- WORDINFILE
  3211. '
  3212. '  INPUTS  -- PARAMETER             MEANING
  3213. '             FILNAME$      FILE TO SEARCH IN
  3214. '             STRNG$        STRING TO SEARCH FOR
  3215. '
  3216. '  OUTPUTS -- INFILE        WHETHER STRING FOUND IN FILE
  3217. '
  3218. '  PURPOSE -- Searches for "STRNG$" in file "FILNAME$."  Used to
  3219. '             limit doors and questionnaires to those specified
  3220. '             in their menu files.  The "STRNG$" is capitalized
  3221. '             but not the lines in the file, so must be exact
  3222. '             case-sensitive match to be found.  The only character
  3223. '             that can immediately proceed or end a name to be
  3224. '             found must be a blank.
  3225. '
  3226.       SUB WORDINFILE (FILNAME$,STRNG$,INFILE) STATIC
  3227.       INFILE = FALSE
  3228.       CALL FINDIT (FILNAME$)
  3229.       IF NOT OK THEN _
  3230.          EXIT SUB
  3231.       X = 0
  3232.       CALL ALLCAPS (STRNG$)
  3233.       WHILE NOT EOF(2) AND X < 1
  3234.          LINE INPUT #2,A$
  3235.          Y = 1
  3236. 10978    X = INSTR(Y,A$,STRNG$)
  3237.          IF X < 1 THEN _
  3238.             GOTO 10980
  3239.          Y = X + 1
  3240.          IF X > 1 THEN _
  3241.             IF MID$(A$,X - 1,1) <> " " THEN _
  3242.                X = 0
  3243.          IF X > 0 THEN _
  3244.             L = LEN(STRNG$) : _
  3245.             IF LEN(A$) => (X + L) THEN _
  3246.                IF MID$(A$,X + L,1) <> " " THEN _
  3247.                   X = 0
  3248.          IF X = 0 THEN _
  3249.             GOTO 10978
  3250. 10980 WEND
  3251.       CLOSE 2
  3252.       INFILE = (X > 0)
  3253.       END SUB
  3254. 10983 ' $SUBTITLE: 'DOOREXIT -- Setup to exit to a "door"'
  3255. ' $PAGE
  3256. '  NAME    -- DOOREXIT
  3257. '
  3258. '  INPUTS  -- PARAMETER             MEANING
  3259. '             MULTI.LINK.PRESENT
  3260. '             NODE.ID$
  3261. '             RBBS.BAT$
  3262. '             Z$
  3263. '
  3264. '  OUTPUTS -- Q                    NUMBER OF LINES TO WRITE OUT TO
  3265. '                                  RCTTY.BAT$
  3266. '             B$()                 LINES TO WRITE OUT TO RCTTY.BAT$
  3267. '
  3268. '  PURPOSE -- Set up B$() and Q in order to call "EXITRBBS" and
  3269. '             exit RBBS-PC to invoke another program
  3270. '
  3271.       SUB DOOREXIT STATIC
  3272.       IF Z$ = "" OR _
  3273.          Z$ = "NONE" THEN _
  3274.          EXIT SUB
  3275.       CALL FINDIT (Z$)
  3276.       IF NOT OK THEN _
  3277.          GOTO 10986
  3278.       EXIT.TO$ = LEFT$(Z$,LEN(Z$) - 4)
  3279.       EXIT.METHOD$ = ""
  3280.       DOORED.TO$ = EXIT.TO$
  3281.       CALL FINDIT (DOORS.DEF$)
  3282.       IF NOT OK THEN _
  3283.          EXIT.TO$ = EXIT.TO$ + " " + NODE.ID$ : _
  3284.          GOTO 10989
  3285. 10985 CALL READPARMS (A$(),8,1)
  3286.       IF EC > 0 THEN _
  3287.          EXIT.TO$ = EXIT.TO$ + " " + NODE.ID$ : _
  3288.          GOTO 10989
  3289.       IF EXIT.TO$ <> A$(1) THEN _
  3290.          GOTO 10985
  3291.       CALL CHECKINT (A$(2))
  3292.       IF EC > 0 THEN _
  3293.          EC = 0 : _
  3294.          GOTO 10985
  3295.       IF USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _
  3296.          CALL QTPUT1 ("Insufficient security for door") : _
  3297.          EXIT SUB
  3298.       X$ = LEFT$(A$(5),INSTR(A$(5)+" "," ")-1)
  3299.       CALL FINDIT (X$)
  3300.       IF NOT OK THEN _
  3301.          GOTO 10986
  3302.       FILE.NAME$ = A$(3)
  3303.       EXIT.METHOD$ = A$(4)
  3304.       EXIT.TEMPLATE$ = A$(5)
  3305.       DOOR.DISPLAY$ = A$(7)
  3306.       DOOR.TIME$ = A$(8)
  3307.       CALL ASKUSERS
  3308.       CALL SMARTTXT (EXIT.TEMPLATE$,FALSE,FALSE)                     ' CS062802
  3309.       CALL METAGSR (EXIT.TEMPLATE$,FALSE)
  3310.       EXIT.TO$ = EXIT.TEMPLATE$
  3311.       GOTO 10989
  3312. 10986 A$ = "Missing door program"
  3313.       CALL UPDTCALR (A$ + " " + Z$,1)
  3314.       SNOOP = TRUE
  3315.       CALL LPRNT (A$,1)
  3316.       EXIT SUB
  3317. 10989 IF TRANSFER.FUNCTION = 3 THEN _
  3318.          Y$ = "Registration" _
  3319.       ELSE Y$ = DOORED.TO$
  3320.       A$ = Y$ + _
  3321.            " door opened at " + _
  3322.            TIME$ + _
  3323.            " on " + _
  3324.            DATE$
  3325.       SUBROUTINE.PARAMETER = 5
  3326.       CALL TPUT
  3327.       CALL UPDTCALR (DOORED.TO$ + " door opened!",2)
  3328.       CLOSE 2
  3329.       OPEN "O",2,"DORINFO" + _
  3330.                  NODE.FILE.ID$ + _
  3331.                  ".DEF"
  3332.       PRINT #2,RBBS.NAME$
  3333.       PRINT #2,SYSOP.FIRST.NAME$
  3334.       PRINT #2,SYSOP.LAST.NAME$
  3335.       IF LOCAL.USER THEN _
  3336.          PRINT #2,"COM0" _
  3337.       ELSE PRINT #2,COM.PORT$
  3338.       B$ = MID$(BAUD.PARITY$,INSTR(BAUD.PARITY$," B"))
  3339.       PRINT #2,TALK.TO.MODEM.AT$;B$
  3340.       PRINT #2,NETWORK.TYPE
  3341.       IF GLOBAL.SYSOP THEN _
  3342.          PRINT #2,"SYSOP" : _
  3343.          PRINT #2,"" _
  3344.       ELSE PRINT #2,FIRST.NAME$ : _
  3345.            PRINT #2,LAST.NAME$
  3346.       PRINT #2,CITY.STATE$
  3347.       PRINT #2,GR
  3348.       PRINT #2,USER.SECURITY.LEVEL
  3349.       CALL TIMEREMAIN (TIME.REMAINING!)
  3350.       CALL CHECKINT (DOOR.TIME$)
  3351.       IF EC > 0 AND TESTED.INTEGER.VALUE > 0 THEN _
  3352.          X! = 60 * TESTED.INTEGER.VALUE : _
  3353.          IF X! < TIME.REMAINING! THEN _
  3354.             TIME.REMAINING! = X!
  3355.       PRINT #2,INT(TIME.REMAINING!)
  3356.       PRINT #2,FOSSIL
  3357.       IF EXIT.METHOD$ = "S" THEN _
  3358.          CALL SHELLEXIT (EXIT.TEMPLATE$) : _
  3359.          EXIT.TO.DOORS = TRUE : _
  3360.          CALL BUFFILE (DOOR.DISPLAY$,X) : _
  3361.          CALL DOORRTN _
  3362.       ELSE A$(1) = DISK.FOR.DOS$ + _
  3363.                   "COMMAND /C " + _
  3364.                   EXIT.TO$ : _
  3365.            A$(2) = RBBS.BAT$ : _
  3366.            CALL RBBSEXIT (A$(),2)
  3367.       END SUB
  3368. 10992 ' $SUBTITLE: 'RBBSEXIT -- Setup to exit RBBS'
  3369. ' $PAGE
  3370. '  NAME    -- RBBSEXIT
  3371. '
  3372. '  INPUTS  -- PARAMETER             MEANING
  3373. '             LINE.ARA        Array of lines to write to batch file
  3374. '             NUM.LINES       How many lines in array
  3375. '
  3376. '  OUTPUTS -- RCTTY.BAT$
  3377. '
  3378. '  PURPOSE -- To create a batch file that control can be passed to
  3379. '             and to exit RBBS-PC while still keeping carrier up
  3380. '
  3381.       SUB RBBSEXIT (LINE.ARA$(1),NUM.LINES) STATIC
  3382.       CLOSE 2
  3383.       IF NUM.LINES = 0 THEN _
  3384.          GOTO 10994
  3385.       OPEN "O",2,RCTTY.BAT$
  3386.       FOR I = 1 TO NUM.LINES
  3387.          IF LINE.ARA$(I) <> "" THEN _
  3388.             PRINT #2,LINE.ARA$(I)
  3389.       NEXT
  3390.       CLOSE 2
  3391. 10994 CLOSE 3
  3392.       EXIT.TO.DOORS = TRUE
  3393.       IF NOT FOSSIL THEN _
  3394.          OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  3395.       IF NOT PRIVATE.DOOR THEN _
  3396.          CALL MLINIT (2)
  3397. 10996 CALL UPDATEU (TRUE)
  3398.       CALL GETIME
  3399.       CALL SAVEPROF (1)
  3400.       IF NUM.LINES = 0 THEN _
  3401.          EXIT SUB
  3402.       CALL DELAYIT (9 + BPS)
  3403.       IF FOSSIL THEN _
  3404.          CALL FOSEXIT(COMPORT%)
  3405.       SYSTEM
  3406.       END SUB
  3407. 12000 ' $SUBTITLE: 'SETSECT -- Setup section prompts'
  3408. ' $PAGE
  3409. '  NAME    -- SETSECT         Doug Azzarito
  3410. '
  3411. '  INPUTS  -- PARAMETER             MEANING
  3412. '             MENU.INDEX      2 = user is in MAIN section
  3413. '                             3 = user is in FILE section
  3414. '                             4 = user is in UTIL section
  3415. '                             6 = user is in LIBR section
  3416. '
  3417. '  OUTPUTS -- SECTION$        4 character section name
  3418. '             ACTIVE.MENU$    1 character section name
  3419. '             SECTION.PROMPT$ Section name (if SHOW.SECTION config)
  3420. '             COMMAND.PROMPT$ Command input prompt string
  3421. '             SECTION.OPTS$   List of options valid in this sect
  3422. '             INVALID.OPTS$   List of options invalid in this sect
  3423. '             SUB.SECTION     Index into security array for section
  3424. '
  3425. '  PURPOSE -- To build the prompt strings for the current section
  3426. '
  3427.       SUB SETSECT STATIC
  3428.       ON MENU.INDEX GOTO 12001, 12010,12005,12020,12001,12015
  3429. 12001 EXIT SUB
  3430. 12005 LSET SECTION$ = "FILE"
  3431.       SECTION.OPTS$ = FILE.OPTS$
  3432.       INVALID.OPTS$ = INVALID.FILE.OPTS$
  3433.       SUB.SECTION = BEG.FILE
  3434.       GOTO 12025
  3435. 12010 LSET SECTION$ = "MAIN"
  3436.       SECTION.OPTS$ = MAIN.OPTS$
  3437.       INVALID.OPTS$ = INVALID.MAIN.OPTS$
  3438.       SUB.SECTION = BEG.MAIN
  3439.       GOTO 12025
  3440. 12015 LSET SECTION$ = "LIBR"
  3441.       SECTION.OPTS$ = LIBRARY.OPTS$
  3442.       INVALID.OPTS$ = INVALID.LIBRARY.OPTS$
  3443.       SUB.SECTION = BEG.LIBRARY
  3444.       GOTO 12025
  3445. 12020 LSET SECTION$ = "UTIL"
  3446.       SECTION.OPTS$ = UTIL.OPTS$
  3447.       INVALID.OPTS$ = INVALID.UTIL.OPTS$
  3448.       SUB.SECTION = BEG.UTIL
  3449. 12025 ACTIVE.MENU$ = LEFT$(SECTION$,1)
  3450.       LSET LAST.COMMAND$ = ACTIVE.MENU$ + " "                        ' KG060701
  3451.       IF SHOW.SECTION THEN _
  3452.          SECTION.PROMPT$ = SECTION$ _
  3453.       ELSE SECTION.PROMPT$ = "Your"
  3454.       IF COMMANDS.IN.PROMPT=0 THEN _
  3455.           SECTION.OPTS$ = ""
  3456.       COMMAND.PROMPT$ = SECTION.PROMPT$ + _
  3457.                         " command" + _
  3458.                         SECTION.OPTS$
  3459.       END SUB
  3460. 12878 ' $SUBTITLE: 'UNTILRIGHT - asks question until answer okay'
  3461. ' $PAGE
  3462. '
  3463. '  NAME    -- UNTILRIGHT
  3464. '
  3465. '  INPUTS  -- PARAMETER             MEANING
  3466. '             QUES$         QUESTION TO BE ASKED THE USER
  3467. '             ANS$          LOCATION TO STORE THE ANSWER
  3468. '             MIN.LEN       MINIMUM LENGTH OF ANSWER
  3469. '             MAX.LEN       MAX LENGTH OF ANSWER
  3470. '
  3471. '  OUTPUTS -- ANS$          RESPONSE TO THE QUESTION WHICH THE
  3472. '                                      CALLERS SAYS IS CORRECT
  3473. '
  3474. '  PURPOSE -- Subroutine to ask a user a question until the caller
  3475. '             responds that the answer is correct
  3476. '
  3477.       SUB UNTILRIGHT (QUES$,ANS$,MIN.LEN,MAX.LEN) STATIC
  3478. 12880 SUBROUTINE.PARAMETER = 1
  3479.       A$ = QUES$
  3480.       CALL TGET
  3481.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3482.          GOTO 12882
  3483.       IF Q = 0 THEN _
  3484.          GOTO 12880
  3485.       IF LEN(B$(1)) > MAX.LEN THEN _
  3486.          CALL QTPUT1 (STR$(MAX.LEN) + " chars max") : _
  3487.          GOTO 12880_
  3488.       ELSE IF LEN(B$(1)) < MIN.LEN THEN _
  3489.               CALL QTPUT1 (STR$(MIN.LEN) + " chars min") : _
  3490.               GOTO 12880
  3491.       ANS$ = B$(1)
  3492.       A$ = B$(1) + _
  3493.            ", right ([Y],N)"
  3494.       TURBO.KEY = -TURBO.KEY.USER
  3495.       SUBROUTINE.PARAMETER = 1
  3496.       CALL TGET
  3497.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3498.          GOTO 12882
  3499.       IF NO THEN _
  3500.          GOTO 12880
  3501.       CALL ALLCAPS (ANS$)
  3502.       EXIT SUB
  3503. 12882 ANS$ = "GUEST"
  3504.       END SUB
  3505. 13660 ' $SUBTITLE: 'LOGERROR - sub to log errors to CALLERS file'
  3506. ' $PAGE
  3507. '
  3508. '  NAME    -- LOGERROR
  3509. '
  3510. '  INPUTS  --     PARAMETER                    MEANING
  3511. '                    ERR           ERROR NUMBER DETECTED BY BASIC
  3512. '                    ERL           LAST LINE NUMBER ENCOUNTERED
  3513. '                                  PRIOR TO ENCOUNTERNING ERROR
  3514. '
  3515. '  OUTPUTS -- NONE
  3516. '
  3517. '  PURPOSE -- To set up a string to write to the callers log
  3518. '             indicating the date, time, error, and error line
  3519. '
  3520.       SUB LOGERROR STATIC
  3521.       IX = ERR
  3522.       IF ERR < 1 THEN _
  3523.          IX = EC
  3524.       CALL UPDTCALR("+++ Error " + _
  3525.            STR$(IX) + _
  3526.            " line " + _
  3527.            STR$(ERL) + _
  3528.            " at " + _
  3529.            TIME$ + _
  3530.            " on " + _
  3531.            DATE$,2)
  3532.       END SUB
  3533. '
  3534. 20096 ' $SUBTITLE: 'CHECKRATIO - subroutine to print ul/dl ratio'
  3535. ' $PAGE
  3536. '
  3537. '  NAME    -- CHECKRATIO
  3538. '
  3539. '  INPUTS  --   PARAMETER                    MEANING
  3540. '               TELL.USER          TELL USER THEIR RATIO
  3541. '               DOWNLOADS          FILES DOWNLOADED
  3542. '               DLBYTES!           BYTES DOWNLOADED
  3543. '               UPLOADS            FILES UPLOADED
  3544. '               ULBYTES!           BYTES UPLOADED
  3545. '
  3546. '  OUTPUTS --   OK                 -1 if okay to download, 0 otherwise
  3547. '
  3548. '  PURPOSE -- To
  3549. '             and to determine whether the users violated
  3550. '             their upload to download restriction
  3551. '
  3552.       SUB CHECKRATIO (TELL.USER) STATIC
  3553.       OK = TRUE
  3554.       IF NOT ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
  3555.          GOTO 20110
  3556.       IF RATIO.RESTRICTION# = 0 THEN _
  3557.          GOTO 20110
  3558. '
  3559. ' DETERMINE METHOD OF RATIO CHECKING TO BE PERFORMED
  3560. '
  3561.       IF BYTE.METHOD = 1 OR BYTE.METHOD = 3 THEN _
  3562.          METHOD$ = "Bytes" : _
  3563.          UL.WORK# = ULBYTES! : _
  3564.          DL.WORK# = DLBYTES!
  3565.       IF BYTE.METHOD = 0 OR BYTE.METHOD = 2 THEN _
  3566.          METHOD$ = "Files" : _
  3567.          UL.WORK# = UPLOADS : _
  3568.          DL.WORK# = DOWNLOADS
  3569.       IF BYTE.METHOD = 2 THEN _
  3570.          TODAY# = RATIO.RESTRICTION# - DL.TODAY!
  3571.       IF BYTE.METHOD = 3 THEN _
  3572.          TODAY# = RATIO.RESTRICTION# - BYTES.TODAY! - NUM.DNLD.BYTS!
  3573. '
  3574.       RATIO# = INT(DL.WORK# / 1)
  3575.       RATIO.SUFFIX$ = ":0"
  3576.       IF UL.WORK# > 0 THEN _
  3577.          RATIO# = INT(DL.WORK# / UL.WORK#) : _
  3578.          RATIO.SUFFIX$ = ":1"
  3579.       IF BYTE.METHOD < 2 THEN _
  3580.          A$ = METHOD$ + " Downloaded:" + STR$(DL.WORK#) + _
  3581.               " Uploaded:" + _
  3582.               STR$(UL.WORK#) + _
  3583.               " Ratio:" + _
  3584.               STR$(RATIO#) + _
  3585.               RATIO.SUFFIX$ : _
  3586.          SUBROUTINE.PARAMETER = 5 : _
  3587.          CALL TPUT
  3588.       IF BYTE.METHOD > 1 THEN _
  3589.          A$ = "Today Downloaded Files: " + STR$(DL.TODAY!) + _
  3590.               " Bytes:" + STR$(BYTES.TODAY!) : _
  3591.          SUBROUTINE.PARAMETER = 5 : _
  3592.          CALL TPUT : _
  3593.          CALL SKIPLINE (1)
  3594. '
  3595. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3596. '
  3597. 20100 IF NOT (RATIO.RESTRICTION# > 0 AND TELL.USER) THEN _
  3598.          EXIT SUB
  3599.       IF BYTE.METHOD <= 1 THEN _
  3600.          GOTO 20105
  3601.       IF TODAY# <= 0 THEN _
  3602.          A$ = "Sorry, Daily download limit of" + _
  3603.               STR$(RATIO.RESTRICTION#) + " " + _
  3604.               METHOD$ + " Reached" : _
  3605.          OK = FALSE _
  3606.       ELSE A$ = "Download balance remaining:" + _
  3607.                 STR$(RATIO.RESTRICTION#) + _
  3608.                 " " + _
  3609.                 METHOD$ : _
  3610.            OK = TRUE
  3611.       SUBROUTINE.PARAMETER = 5
  3612.       CALL TPUT
  3613.       CALL SKIPLINE(1)
  3614.       EXIT SUB
  3615. '
  3616. 20105 IF RATIO# >= RATIO.RESTRICTION# THEN _
  3617.          OK = FALSE : _
  3618.          A$ = "Sorry, DL/UL ratio of" + _
  3619.               STR$(RATIO.RESTRICTION#) + _
  3620.               ":1 " + _
  3621.               METHOD$ + " exceeded" : _
  3622.          SUBROUTINE.PARAMETER = 5 : _
  3623.          CALL TPUT : _
  3624.          A$ = "Minimum upload of" + _
  3625.               STR$(INT(((DL.WORK# - (UL.WORK# * RATIO.RESTRICTION#)) _
  3626.               / RATIO.RESTRICTION#) + 1)) + _
  3627.               + " " + METHOD$ + " required before may download" _
  3628.       ELSE A$ = "Balance remaining before upload required:" + _
  3629.                 STR$(INT((UL.WORK# * RATIO.RESTRICTION#)-DL.WORK#)) + _
  3630.                 " " + METHOD$
  3631.       SUBROUTINE.PARAMETER = 5
  3632.       CALL TPUT
  3633.       CALL SKIPLINE (1)
  3634. 20110 END SUB
  3635. 20140 ' $SUBTITLE: 'GETARC - sub to get what files to verbose list'
  3636. ' $PAGE
  3637. '
  3638. '  NAME    -- GETARC
  3639. '
  3640. '  INPUTS  --     PARAMETER                    MEANING
  3641. '                 Q                     NUMBER OF ENTRIES TYPED
  3642. '                 B$()                  ENTRIES TYPED
  3643. '
  3644. '  OUTPUTS --
  3645. '
  3646. '  PURPOSE --  Process the V)erbose list command.
  3647. '              Takes what user types and tries to list it.
  3648. '
  3649.       SUB GETARC STATIC
  3650.       IF Q > 1 THEN _
  3651.          B = 2 : _
  3652.          GOTO 20142
  3653. 20141 CALL QTPUT1 ("Default extension is "+DEFAULT.EXTENSION$)
  3654.       A$ = "What compressed file(s)" + PRESS.ENTER.EXPERT$
  3655.       SUBROUTINE.PARAMETER = 1
  3656.       CALL TGET
  3657.       IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _
  3658.          EXIT SUB
  3659.       B = 1
  3660. 20142 LAST.INDEX = Q
  3661.       ANS.INDEX = B
  3662.       VIOLATION$ = "View ARC"
  3663.       FOR ARC.INDEX = ANS.INDEX TO LAST.INDEX
  3664.          GOSUB 20143
  3665.          IF SUBROUTINE.PARAMETER < 0 THEN _
  3666.             ARC.INDEX = LAST.INDEX + 1
  3667.       NEXT
  3668.       IF LAST.INDEX > 1 THEN _
  3669.          EXIT SUB _
  3670.       ELSE GOTO 20141
  3671. 20143 Z$ = B$(ARC.INDEX)
  3672.       CALL ALLCAPS (Z$)
  3673.       CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)
  3674.       IF EXT$ = "" THEN _
  3675.          EXT$ = DEFAULT.EXTENSION$ : _
  3676.          Z$ = Z$ + "." + DEFAULT.EXTENSION$
  3677.       FILE.NAME.HOLD$ = Z$
  3678.       FILE.NAME$ = Z$
  3679.       CALL BADFILE (PREFIX$,BAD.FILE.NAME.INDEX)
  3680.       ON BAD.FILE.NAME.INDEX GOTO 20144,20146,20147
  3681. 20144 CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  3682.       ON BAD.FILE.NAME.INDEX GOTO 20145,20146,20147
  3683. 20145 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + (NOT SYSOP),TRUE)
  3684.       IF OK THEN _
  3685.          GOTO 20148
  3686. 20146 Z$ = B$(ARC.INDEX) + _
  3687.            " not found!"
  3688.       CALL UPDTCALR (Z$,2)
  3689.       A$ = Z$ + _
  3690.            " Type correct filename" + PRESS.ENTER.EXPERT$
  3691.       SUBROUTINE.PARAMETER = 1
  3692.       CALL TGET
  3693.       IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _
  3694.          RETURN
  3695.       B$(ARC.INDEX) = B$(1)
  3696.       GOTO 20143
  3697. 20147 CALL SVIOLATION
  3698.       IF DENY.ACCESS THEN _
  3699.          EXIT SUB
  3700.       GOTO 20146
  3701. 20148 X$ = DISK.FOR.DOS$ + "V" + EXT$ + ".BAT"
  3702.       CALL FINDIT (X$)
  3703.       IF NOT OK THEN _
  3704.          GOTO 20150
  3705.       GSR.ARA$(3) = MID$(RIGHT$(COM.PORT$,1)+"0",1-LOCAL.USER, 1)
  3706.       CALL READDIR (2,1)
  3707.       IF EOF(2) THEN _
  3708.          Z$ = A$ : _
  3709.          GSR.ARA$(1) = FILE.NAME$ : _
  3710.          GSR.ARA$(2) = ARC.WORK$ _
  3711.       ELSE Z$ = X$ + " " + FILE.NAME$ + _
  3712.                 " " + ARC.WORK$ + " " + GSR.ARA$(3)
  3713.       CALL SHELLEXIT (Z$)
  3714.       CALL BUFFILE (ARC.WORK$,X)
  3715.       RETURN
  3716. 20150 IF INSTR(".ARC.PAK.ZIP.LZH.","."+EXT$+".") < 1 THEN _          ' DA051101
  3717.          CALL QTPUT1 ("View for "+EXT$+" not implemented") : _
  3718.          RETURN
  3719.       CALL QTPUT1 (FILE.NAME.HOLD$ + " has these files")
  3720.       CALL VIEWARC
  3721.       RETURN
  3722.       END SUB
  3723. 20235 ' $SUBTITLE: 'BADNAME - subroutine to find bad file names'
  3724. ' $PAGE
  3725. '
  3726. '  NAME    -- BADNAME
  3727. '
  3728. '  INPUTS  --     PARAMETER                    MEANING
  3729. '               ACTIVE.MESSAGE.FILE$
  3730. '               ACTIVE.USER.FILE$
  3731. '               CALLERS.FILE$
  3732. '               COMMENTS.FILE$
  3733. '               CONFIG.FILEANAME$
  3734. '               MAIN.MESSAGE.BACKUP$
  3735. '               MAIN.MESSAGE.FILE$
  3736. '               MAXIMUM.VIOLATIONS
  3737. '               PASSWORDS.FILE$
  3738. '               RBBS.BAT$
  3739. '               RCTTY.BAT$
  3740. '               SUBDIR$()
  3741. '               SUBDIR.INDEX
  3742. '               VIOLATION$
  3743. '               VIOLATIONS.THIS.SESSION
  3744. '               Z$                          NAME OF FILE
  3745. '
  3746. '  OUTPUTS  -- BAD.FILE.NAME.INDEX         1 = FILE NAME IS OK
  3747. '                                          2 = SECURITY BREACH TRIED
  3748. '              VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  3749. '              FILENAME$                   NAME OF FILE
  3750. '
  3751. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  3752. '             to either crash the system or to breach RBBS-PC's security
  3753. '
  3754.       SUB BADNAME (BAD.FILE.NAME.INDEX) STATIC
  3755. '
  3756. '
  3757. ' *  TEST FOR SYSTEM FILE ATTEMPT
  3758. '
  3759.       BAD.FILE.NAME.INDEX = 2
  3760.       Z$ = FILE.NAME$
  3761.       CALL BRKFNAME (FILE.NAME$,DR$,PREFIX$,EXTENSION$,FALSE)
  3762.       IF LEN(EXTENSION$) = 3 THEN _
  3763.          IF INSTR("DEF,MNU,OLD,PUI,BAK,",EXTENSION$+",") > 0 THEN _
  3764.             EXIT SUB
  3765.       OK = 0
  3766.       CALL FSECCHK (ACTIVE.MESSAGE.FILE$,PREFIX$,EXTENSION$)
  3767.       CALL FSECCHK (ACTIVE.USER.FILE$,PREFIX$,EXTENSION$)
  3768.       CALL FSECCHK (CALLERS.FILE$,PREFIX$,EXTENSION$)
  3769.       CALL FSECCHK (COMMENTS.FILE$,PREFIX$,EXTENSION$)
  3770.       CALL FSECCHK (FILESEC.FILE$,PREFIX$,EXTENSION$)
  3771.       CALL FSECCHK (MAIN.MESSAGE.BACKUP$,PREFIX$,EXTENSION$)
  3772.       CALL FSECCHK (ORIG.MESSAGE.FILE$,PREFIX$,EXTENSION$)
  3773.       CALL FSECCHK (ORIG.USER.FILE$,PREFIX$,EXTENSION$)
  3774.       CALL FSECCHK (PASSWORDS.FILE$,PREFIX$,EXTENSION$)
  3775.       CALL FSECCHK (RBBS.BAT$,PREFIX$,EXTENSION$)
  3776.       CALL FSECCHK (RCTTY.BAT$,PREFIX$,EXTENSION$)
  3777.       CALL FSECCHK (CONFIG.FILENAME$,PREFIX$,EXTENSION$)
  3778.       IF OK > 0 THEN _
  3779.          EXIT SUB
  3780.       BAD.FILE.NAME.INDEX = 1
  3781.       END SUB
  3782. 20240 ' $SUBTITLE: 'FSECCHK - checks file match except for drive'
  3783. ' $PAGE
  3784. '
  3785. '  NAME    -- FSECCHK
  3786. '
  3787. '  INPUTS  --     PARAMETER                    MEANING
  3788. '               CHECK.THIS$          Name of file to check
  3789. '               PREF2$               Prefix to match against
  3790. '               EXT2$                Extension to match against
  3791. '
  3792. '  OUTPUTS  -- OK                    1 if got match
  3793. '
  3794. '  PURPOSE -- Checks for match on both prefix and extension of a file
  3795. '             name.   Used to catch match on system files not to be
  3796. '             downloaded.
  3797. '
  3798.       SUB FSECCHK (CHECK.THIS$,PREF2$,EXT2$) STATIC
  3799.       IF OK > 0 THEN _
  3800.          EXIT SUB
  3801.       CALL BRKFNAME (CHECK.THIS$,DR$,PREF1$,EXT1$,FALSE)
  3802.       IF PREF1$ = PREF2$ THEN _
  3803.          IF EXT1$ = EXT2$ THEN _
  3804.             OK = 1
  3805.       END SUB
  3806.